R/graphs.R

In R4VN: Health Data Analysis and Publication-Ready Reporting

# R4VN graph functions -----------------------------------------------------
# Base-R plotting wrappers with tidy, consistent arguments and no new
# package dependency. Run devtools::document() after adding this file.

.r4vn_plot_palettes <- list(
  default = c("#2F6B8A", "#E07A5F", "#59A14F", "#F2CC8F", "#8E6C8A", "#76B7B2", "#EDC948", "#B07AA1"),
  journal = c("#1F4E79", "#C0504D", "#548235", "#8064A2", "#BF9000", "#2F75B5", "#A64D79", "#7F6000"),
  blue = c("#08306B", "#2171B5", "#6BAED6", "#C6DBEF"),
  green = c("#00441B", "#238B45", "#74C476", "#C7E9C0"),
  warm = c("#9B2226", "#CA6702", "#EE9B00", "#E9D8A6"),
  gray = c("#252525", "#636363", "#969696", "#D9D9D9"),
  colourblind = c("#0072B2", "#D55E00", "#009E73", "#CC79A7", "#E69F00", "#56B4E9", "#F0E442", "#000000")
)

.r4vn_deparse <- function(x) paste(deparse(x, width.cutoff = 500L), collapse = "")

.r4vn_get_data <- function(data = NULL) {
  if (!is.null(data)) {
    if (!is.data.frame(data)) data <- as.data.frame(data)
    return(data)
  }
  for (op in c("R4VN.active_data", "r4vn.active_data")) {
    z <- getOption(op)
    if (is.data.frame(z)) return(z)
  }
  for (fn in c("active_data", "get_active_data", ".r4vn_get_active_data")) {
    f <- get0(fn, mode = "function", inherits = TRUE)
    if (!is.null(f)) {
      z <- try(f(), silent = TRUE)
      if (is.data.frame(z)) return(z)
    }
  }
  for (en in c(".r4vn_env", ".R4VN_env", ".r4vn_state")) {
    e <- get0(en, inherits = TRUE)
    if (is.environment(e)) {
      for (nm in c("active_data", "active", "data")) {
        if (exists(nm, envir = e, inherits = FALSE)) {
          z <- get(nm, envir = e, inherits = FALSE)
          if (is.data.frame(z)) return(z)
        }
      }
    }
  }
  stop("`data` is required. Supply a data frame or activate one using R4VN.", call. = FALSE)
}

.r4vn_graph_eval_var <- function(expr, data, env, arg, allow_null = FALSE) {
  if (identical(expr, quote(NULL))) {
    if (allow_null) return(NULL)
    stop(sprintf("`%s` is required.", arg), call. = FALSE)
  }
  if (is.symbol(expr)) {
    nm <- as.character(expr)
    if (nm %in% names(data)) return(data[[nm]])
  }
  if (is.character(expr) && length(expr) == 1L && expr %in% names(data)) return(data[[expr]])
  val <- try(eval(expr, envir = data, enclos = env), silent = TRUE)
  if (inherits(val, "try-error")) stop(sprintf("Cannot evaluate `%s`.", arg), call. = FALSE)
  if (is.character(val) && length(val) == 1L && val %in% names(data)) val <- data[[val]]
  if (length(val) != nrow(data)) stop(sprintf("`%s` must identify one variable or return %d values.", arg, nrow(data)), call. = FALSE)
  val
}

.r4vn_var_title <- function(expr, data, supplied = NULL) {
  if (!is.null(supplied)) return(supplied)
  if (is.character(expr) && length(expr) == 1L && expr %in% names(data)) {
    lab <- attr(data[[expr]], "label", exact = TRUE)
    if (!is.null(lab) && nzchar(as.character(lab)[1L])) return(as.character(lab)[1L])
    return(expr)
  }
  if (is.symbol(expr)) {
    nm <- as.character(expr)
    if (nm %in% names(data)) {
      lab <- attr(data[[nm]], "label", exact = TRUE)
      if (!is.null(lab) && nzchar(as.character(lab)[1L])) return(as.character(lab)[1L])
      return(nm)
    }
  }
  .r4vn_deparse(expr)
}

.r4vn_is_missing_expr <- function(expr) identical(expr, quote(expr = )) || identical(expr, quote(NULL))

.r4vn_factor <- function(x, missing = FALSE, missing_label = "Missing") {
  if (missing) {
    z <- as.character(x)
    z[is.na(z)] <- missing_label
    lev <- if (is.factor(x)) c(levels(x), missing_label) else unique(z)
    lev <- unique(lev[lev %in% z])
    return(factor(z, levels = lev))
  }
  if (is.factor(x)) return(droplevels(x))
  factor(x, levels = unique(x[!is.na(x)]))
}

.r4vn_graph_labels <- function(levels, labels = NULL, arg = "xlab") {
  if (is.null(labels)) return(as.character(levels))
  labels <- as.character(labels)
  if (!is.null(names(labels)) && any(nzchar(names(labels)))) {
    out <- as.character(levels)
    hit <- match(out, names(labels))
    out[!is.na(hit)] <- labels[hit[!is.na(hit)]]
    return(out)
  }
  if (length(labels) != length(levels)) stop(sprintf("`%s` must have %d labels.", arg, length(levels)), call. = FALSE)
  labels
}

.r4vn_colors <- function(n, color = NULL, palette = "default", alpha = 1) {
  if (n < 1L) return(character())
  if (!is.numeric(alpha) || length(alpha) != 1L || is.na(alpha) || alpha < 0 || alpha > 1) stop("`alpha` must be between 0 and 1.", call. = FALSE)
  if (is.null(color)) {
    if (length(palette) > 1L) cols <- palette else {
      key <- tolower(as.character(palette)[1L])
      if (!key %in% names(.r4vn_plot_palettes)) stop(sprintf("Unknown palette `%s`. Available palettes: %s.", key, paste(names(.r4vn_plot_palettes), collapse = ", ")), call. = FALSE)
      cols <- .r4vn_plot_palettes[[key]]
    }
  } else cols <- as.character(color)
  cols <- rep(cols, length.out = n)
  if (alpha < 1) cols <- grDevices::adjustcolor(cols, alpha.f = alpha)
  cols
}

.r4vn_theme <- function(theme = "journal", size = 11, note = NULL) {
  theme <- match.arg(tolower(theme), c("journal", "clean", "minimal", "classic"))
  if (!is.numeric(size) || length(size) != 1L || is.na(size) || size <= 0) stop("`size` must be a positive number.", call. = FALSE)
  # Restore only parameters changed by this helper. Restoring the full par()
  # state would also reset mfrow/mfg and break combined multi-panel figures.
  old <- graphics::par(c(
    "mar", "mgp", "tcl", "las", "cex.axis", "cex.lab", "cex.main",
    "bty", "xaxs", "yaxs", "pty"
  ))
  mar <- c(if (is.null(note)) 4.2 else 5.2, 4.5, 3.2, 1.2)
  graphics::par(mar = mar, mgp = c(2.6, 0.75, 0), tcl = -0.25, las = 1, cex.axis = size / 11, cex.lab = size / 11, cex.main = size / 10, bty = if (theme %in% c("clean", "minimal")) "n" else if (theme == "classic") "l" else "o", xaxs = "r", yaxs = "r")
  old
}

.r4vn_add_titles <- function(subtitle = NULL, note = NULL, size = 11) {
  if (!is.null(subtitle)) graphics::mtext(subtitle, side = 3, line = 0.25, adj = 0, cex = size / 12)
  if (!is.null(note)) graphics::mtext(note, side = 1, line = 4.1, adj = 0, cex = size / 13)
}

.r4vn_reference_lines <- function(xline = NULL, yline = NULL,
                                   vline = NULL, hline = NULL) {
  if (!is.null(xline) && !is.null(vline)) {
    stop("Use only `xline`; `vline` is its deprecated alias.", call. = FALSE)
  }
  if (!is.null(yline) && !is.null(hline)) {
    stop("Use only `yline`; `hline` is its deprecated alias.", call. = FALSE)
  }
  list(
    xline = if (is.null(xline)) vline else xline,
    yline = if (is.null(yline)) hline else yline
  )
}

.r4vn_add_reference_lines <- function(xline = NULL, yline = NULL,
                                       color = "gray40", lty = 2, lwd = 1) {
  if (!is.null(yline)) {
    yy <- as.numeric(yline); yy <- yy[is.finite(yy)]
    if (length(yy)) for (i in seq_along(yy)) graphics::abline(h = yy[i], col = rep(color, length.out = length(yy))[i], lty = rep(lty, length.out = length(yy))[i], lwd = rep(lwd, length.out = length(yy))[i])
  }
  if (!is.null(xline)) {
    xx <- as.numeric(xline); xx <- xx[is.finite(xx)]
    if (length(xx)) for (i in seq_along(xx)) graphics::abline(v = xx[i], col = rep(color, length.out = length(xx))[i], lty = rep(lty, length.out = length(xx))[i], lwd = rep(lwd, length.out = length(xx))[i])
  }
  invisible(NULL)
}

.r4vn_axis <- function(side, values, labels = NULL, breaks = NULL) {
  if (is.null(labels) && is.null(breaks)) return(graphics::Axis(values, side = side))
  if (is.null(breaks)) {
    finite <- values[is.finite(values)]
    if (!length(finite)) return(invisible(NULL))
    if (is.null(labels)) breaks <- pretty(range(finite), n = 5) else {
      rr <- range(finite)
      breaks <- if (length(labels) == 1L) mean(rr) else seq(rr[1L], rr[2L], length.out = length(labels))
    }
  }
  if (is.null(labels)) labels <- format(breaks, trim = TRUE)
  if (length(labels) != length(breaks)) stop("Tick labels and breaks must have the same length.", call. = FALSE)
  graphics::axis(side, at = breaks, labels = labels)
}

.r4vn_open_device <- function(file, width, height, dpi, bg = "white") {
  ext <- tolower(tools::file_ext(file))
  dir.create(dirname(normalizePath(file, winslash = "/", mustWork = FALSE)), recursive = TRUE, showWarnings = FALSE)
  if (ext == "png") grDevices::png(file, width = width, height = height, units = "in", res = dpi, bg = bg)
  else if (ext %in% c("jpg", "jpeg")) grDevices::jpeg(file, width = width, height = height, units = "in", res = dpi, quality = 95, bg = bg)
  else if (ext %in% c("tif", "tiff")) grDevices::tiff(file, width = width, height = height, units = "in", res = dpi, compression = "lzw", bg = bg)
  else if (ext == "pdf") grDevices::pdf(file, width = width, height = height, bg = bg, useDingbats = FALSE)
  else if (ext == "svg") grDevices::svg(file, width = width, height = height, bg = bg)
  else stop("Unsupported file type. Use png, jpg, tiff, pdf, or svg.", call. = FALSE)
}

.r4vn_render <- function(draw, file = NULL, show = TRUE, width = 7, height = 5, dpi = 300, bg = "white") {
  if (!is.logical(show) || length(show) != 1L || is.na(show)) stop("`show` must be TRUE or FALSE.", call. = FALSE)
  if (!is.null(file)) {
    .r4vn_open_device(file, width, height, dpi, bg)
    ok <- FALSE
    tryCatch({ draw(); ok <- TRUE }, finally = grDevices::dev.off())
    if (!ok) stop("The graph could not be written.", call. = FALSE)
  }
  if (show) draw()
  invisible(file)
}

.r4vn_graph_result <- function(type, data, call, file = NULL, draw = NULL) {
  structure(
    list(type = type, data = data, call = call, file = file, draw = draw),
    class = "r4vn_graph"
  )
}

.r4vn_draw_graph_set <- function(x, ncol = NULL) {
  n <- length(x$graphs)
  if (!n) return(invisible(x))
  if (is.null(ncol)) ncol <- ceiling(sqrt(n))
  ncol <- as.integer(ncol)[1L]
  if (!is.finite(ncol) || ncol < 1L) {
    stop("`ncol` must be a positive integer.", call. = FALSE)
  }
  ncol <- min(ncol, n)
  nrow <- ceiling(n / ncol)
  old <- graphics::par(c("mfrow", "mar", "oma"))
  on.exit(graphics::par(old), add = TRUE)
  graphics::par(mfrow = c(nrow, ncol), oma = c(0, 0, 0, 0))
  for (graph in x$graphs) {
    if (!is.function(graph$draw)) {
      stop("This graph cannot be redrawn in a combined figure.", call. = FALSE)
    }
    graph$draw()
  }
  invisible(x)
}

#' Plot an R4VN graph result
#'
#' @param x An R4VN graph or graph collection.
#' @param ncol Number of columns for a graph collection.
#' @param ... Not used.
#' @return `x`, invisibly.
#' @export
plot.r4vn_graph <- function(x, ...) {
  if (is.function(x$draw)) x$draw()
  invisible(x)
}

#' @rdname plot.r4vn_graph
#' @export
plot.r4vn_graph_set <- function(x, ncol = NULL, ...) {
  .r4vn_draw_graph_set(x, ncol = ncol %||% x$ncol)
}

#' Print an R4VN graph result
#'
#' Returns an R4VN graph object invisibly without writing status text to the
#' console.
#'
#' @param x An object of class `r4vn_graph`.
#' @param ... Not used.
#' @return `x`, invisibly.
#' @export
print.r4vn_graph <- function(x, ...) {
  invisible(x)
}

#' Bar chart
#'
#' Draws counts, percentages, means, or medians by a categorical variable. An
#' optional `by` variable creates grouped or stacked bars. The function uses
#' base R graphics and accepts unquoted variable names. `vars()` can request
#' several x variables. With `by = vars(province, sex, outcome)`, province and
#' sex are nested strata and outcome is the innermost in-graph grouping.
#'
#' @usage
#' gbar(
#'   data = NULL, x = NULL, vars = NULL, y = NULL, by = NULL,
#'   stat = c("mean", "median"), percent = FALSE, position = c("dodge", "stack"),
#'   ci = FALSE, label = FALSE, digits = 1, xlab = NULL, ylab = NULL,
#'   xtitle = NULL, ytitle = NULL, ybreaks = NULL, title = NULL, subtitle = NULL,
#'   note = NULL, color = NULL, palette = "default", alpha = 1,
#'   border_color = NA, border_lwd = 1, legend = TRUE,
#'   legend_position = "topright", missing = FALSE, missing_label = "Missing",
#'   xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1,
#'   theme = "journal", size = 11, combine = FALSE, ncol = NULL, file = NULL,
#'   width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL,
#'   hline = NULL
#' )
#'
#' @param data A data frame. It may be omitted when an active R4VN data frame exists.
#' @param x Categorical variable on the horizontal axis. Supply an unquoted name or a character name.
#' @param vars Optional `vars(...)` selector used to request several variables in one call.
#' @param y Optional numeric variable. When omitted, bars show counts or percentages. When supplied, bars show a mean or median.
#' @param by Optional grouping variable or hierarchical `vars(...)` specification.
#' @param stat Summary for `y`: `"mean"` or `"median"`.
#' @param percent For count charts: `FALSE` for counts, `TRUE` or `"x"` for percentages within each x category, `"by"` for percentages within each by group, or `"total"` for percentages of all observations.
#' @param position `"dodge"` for side-by-side bars or `"stack"` for stacked bars.
#' @param ci Show a 95 percent confidence interval for mean bars. Only available when `y` is supplied and `stat = "mean"`.
#' @param label Add values above or inside bars.
#' @param digits Number of digits in value labels.
#' @param xlab Optional category labels. Use an unnamed vector in displayed order or a named vector such as `c(M = "Male", F = "Female")`.
#' @param ylab Optional y-axis tick labels.
#' @param xtitle,ytitle Axis titles. Variable names or variable labels are used automatically when possible.
#' @param ybreaks Numeric positions used with `ylab`.
#' @param title,subtitle,note Main title, subtitle, and note.
#' @param color A color name or vector of colors. When `NULL`, `palette` is used.
#' @param palette One of `"default"`, `"journal"`, `"blue"`, `"green"`, `"warm"`, `"gray"`, or `"colourblind"`; alternatively, a color vector.
#' @param alpha Color opacity from 0 to 1.
#' @param legend Show the legend when `by` is supplied.
#' @param legend_position Base-R legend position, for example `"topright"` or `"topleft"`.
#' @param missing Include missing x or by values as a category.
#' @param missing_label Label used for missing values.
#' @param xline,yline Optional numeric reference lines on the x and y axes.
#'   Thus `xline` draws vertical lines and `yline` draws horizontal lines.
#' @param vline,hline Deprecated aliases for `xline` and `yline`.
#' @param ref_color,ref_lty,ref_lwd Color, line type, and width for reference lines; vectors are recycled for multiple lines.
#' @param theme Graph theme: `"journal"`, `"clean"`, `"minimal"`, or `"classic"`.
#' @param size Base font size.
#' @param combine When several graphs are produced, draw them as labelled panels
#'   in one figure.
#' @param ncol Optional number of columns in a combined figure.
#' @param file Optional output file ending in png, jpg, tiff, pdf, or svg.
#' @param width,height Output width and height in inches.
#' @param dpi Resolution for raster output.
#' @param show Draw the graph in the current graphics device.
#' @param bg Background color for exported files.
#'
#' @param border_color,border_lwd Bar-border colour and line width. Use `NA` for no border.
#' @return An object of class `r4vn_graph`. Its `data` component contains the plotted summary.
#' @examples
#' d <- data.frame(
#'   sex = factor(c("Male", "Female", "Female", "Male", "Female")),
#'   hypertension = factor(c("No", "Yes", "No", "Yes", "No")),
#'   age = c(32, 45, 37, 51, 29)
#' )
#' gbar(d, x = sex)
#' gbar(d, x = sex, by = hypertension, percent = "x")
#' gbar(d, x = sex, y = age, ci = TRUE, ytitle = "Mean age")
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(sex = factor(c("Male", "Female", "Female", "Male", "Female")),
#'                 outcome = factor(c("No", "Yes", "No", "Yes", "No")),
#'                 age = c(32, 45, 37, 51, 29))
#' gbar(d, x = sex, show = FALSE)
#' gbar(d, x = sex, percent = TRUE, label = TRUE, show = FALSE)
#' gbar(d, x = sex, by = outcome, percent = "x", position = "dodge", show = FALSE)
#' gbar(d, x = sex, by = outcome, percent = "total", position = "stack", show = FALSE)
#' gbar(d, x = sex, y = age, stat = "mean", ci = TRUE, show = FALSE)
#' gbar(d, x = sex, y = age, stat = "median", show = FALSE)
#' gbar(d, x = sex, title = "Participants by sex", palette = "journal", show = FALSE)
#' f <- tempfile(fileext = ".png")
#' gbar(d, x = sex, file = f, show = FALSE)
#' }
#' @export
gbar <- function(data = NULL, x, y = NULL, by = NULL, stat = c("mean", "median"), percent = FALSE, position = c("dodge", "stack"), ci = FALSE, label = FALSE, digits = 1, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 1, border_color = NA, border_lwd = 1, legend = TRUE, legend_position = "topright", missing = FALSE, missing_label = "Missing", xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); ye <- substitute(y); be <- substitute(by)
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  xv <- .r4vn_graph_eval_var(xe, data, env, "x"); yv <- .r4vn_graph_eval_var(ye, data, env, "y", TRUE); bv <- .r4vn_graph_eval_var(be, data, env, "by", TRUE)
  stat <- match.arg(stat); position <- match.arg(position); xf <- .r4vn_factor(xv, missing, missing_label); bf <- if (is.null(bv)) NULL else .r4vn_factor(bv, missing, missing_label)
  if (!is.null(yv) && !is.numeric(yv)) stop("`y` must be numeric.", call. = FALSE)
  keep <- !is.na(xf)
  if (!is.null(bf)) keep <- keep & !is.na(bf)
  if (!is.null(yv)) keep <- keep & is.finite(yv)
  xf <- droplevels(xf[keep]); if (!is.null(bf)) bf <- droplevels(bf[keep]); if (!is.null(yv)) yv <- yv[keep]
  if (!length(xf)) stop("No non-missing observations are available.", call. = FALSE)
  xl <- .r4vn_graph_labels(levels(xf), xlab); xt <- .r4vn_var_title(xe, data, xtitle); yt <- ytitle
  error_low <- error_high <- NULL
  if (is.null(yv)) {
    if (is.null(bf)) {
      values <- as.numeric(table(xf)); names(values) <- levels(xf)
      mode <- if (isTRUE(percent)) "x" else if (identical(percent, FALSE)) "count" else tolower(as.character(percent)[1L])
      if (!mode %in% c("count", "x", "by", "total")) stop("`percent` must be FALSE, TRUE, 'x', 'by', or 'total'.", call. = FALSE)
      if (mode != "count") values <- values / sum(values) * 100
      yt <- if (is.null(yt)) if (mode == "count") "Count" else "Percent" else yt
      summary_data <- data.frame(x = levels(xf), value = values, stringsAsFactors = FALSE)
    } else {
      tab <- table(xf, bf); values <- t(unclass(tab)); mode <- if (isTRUE(percent)) "x" else if (identical(percent, FALSE)) "count" else tolower(as.character(percent)[1L])
      if (!mode %in% c("count", "x", "by", "total")) stop("`percent` must be FALSE, TRUE, 'x', 'by', or 'total'.", call. = FALSE)
      if (mode == "x") values <- sweep(values, 2, colSums(values), "/") * 100
      if (mode == "by") values <- sweep(values, 1, rowSums(values), "/") * 100
      if (mode == "total") values <- values / sum(values) * 100
      values[!is.finite(values)] <- 0
      yt <- if (is.null(yt)) if (mode == "count") "Count" else "Percent" else yt
      summary_data <- as.data.frame(as.table(values), stringsAsFactors = FALSE); names(summary_data) <- c("by", "x", "value")
    }
  } else {
    if (is.null(bf)) {
      spl <- split(yv, xf, drop = TRUE); values <- vapply(spl, if (stat == "mean") mean else stats::median, numeric(1), na.rm = TRUE)
      n <- vapply(spl, function(z) sum(is.finite(z)), integer(1)); sdv <- vapply(spl, stats::sd, numeric(1), na.rm = TRUE)
      if (ci && stat == "mean") { se <- sdv / sqrt(n); error_low <- values - stats::qt(0.975, pmax(n - 1, 1)) * se; error_high <- values + stats::qt(0.975, pmax(n - 1, 1)) * se }
      summary_data <- data.frame(x = names(values), n = n, value = as.numeric(values), lower = if (is.null(error_low)) NA_real_ else error_low, upper = if (is.null(error_high)) NA_real_ else error_high, stringsAsFactors = FALSE)
    } else {
      gx <- levels(xf); gb <- levels(bf); values <- matrix(NA_real_, nrow = length(gb), ncol = length(gx), dimnames = list(gb, gx)); nmat <- values; sdmat <- values
      for (i in seq_along(gb)) for (j in seq_along(gx)) { z <- yv[bf == gb[i] & xf == gx[j]]; z <- z[is.finite(z)]; if (length(z)) { values[i, j] <- if (stat == "mean") mean(z) else stats::median(z); nmat[i, j] <- length(z); sdmat[i, j] <- if (length(z) > 1) stats::sd(z) else NA_real_ } }
      if (ci && stat == "mean") { se <- sdmat / sqrt(nmat); error_low <- values - stats::qt(0.975, pmax(nmat - 1, 1)) * se; error_high <- values + stats::qt(0.975, pmax(nmat - 1, 1)) * se }
      summary_data <- as.data.frame(as.table(values), stringsAsFactors = FALSE); names(summary_data) <- c("by", "x", "value"); summary_data$n <- as.vector(nmat); summary_data$lower <- if (is.null(error_low)) NA_real_ else as.vector(error_low); summary_data$upper <- if (is.null(error_high)) NA_real_ else as.vector(error_high)
    }
    yt <- if (is.null(yt)) paste0(if (stat == "mean") "Mean " else "Median ", .r4vn_var_title(ye, data)) else yt
    if (ci && stat != "mean") warning("Confidence intervals are only calculated for mean bars.", call. = FALSE)
    if (ci && position == "stack") warning("Confidence intervals are not drawn for stacked bars.", call. = FALSE)
  }
  ncolor <- if (is.null(bf)) max(1L, length(values)) else nrow(values); cols <- .r4vn_colors(ncolor, color, palette, alpha)
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE)
    ylim_max <- max(c(values, error_high), na.rm = TRUE); ylim_min <- min(c(0, values, error_low), na.rm = TRUE); pad <- if (is.finite(ylim_max - ylim_min)) 0.12 * (ylim_max - ylim_min) else 1
    mids <- graphics::barplot(values, beside = position == "dodge", names.arg = xl, col = cols, border = border_color, lwd = border_lwd, axes = FALSE, axisnames = TRUE, ylim = c(ylim_min, ylim_max + pad), xlab = xt, ylab = yt, main = title)
    .r4vn_axis(2, as.numeric(values), ylab, ybreaks)
    graphics::box(bty = graphics::par("bty"))
    if (!is.null(error_low) && position == "dodge") {
      graphics::arrows(mids, error_low, mids, error_high, angle = 90, code = 3, length = 0.04)
    }
    if (isTRUE(label)) {
      labs <- format(round(values, digits), nsmall = digits, trim = TRUE)
      if (is.matrix(values)) {
        if (position == "dodge") graphics::text(mids, values, labels = labs, pos = 3, cex = size / 13)
        else { yy <- apply(values, 2, cumsum) - values / 2; graphics::text(mids, yy, labels = labs, cex = size / 13) }
      } else graphics::text(mids, values, labels = labs, pos = 3, cex = size / 13)
    }
    if (!is.null(bf) && isTRUE(legend)) graphics::legend(legend_position, legend = levels(bf), title = .r4vn_var_title(be, data), fill = cols, border = NA, bty = "n", cex = size / 12)
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg)
  .r4vn_graph_result("bar", summary_data, call, file, draw = draw)
}

#' Histogram
#'
#' Draws histograms for one or several numeric variables using base R graphics.
#' `by` may be a single grouping variable or hierarchical `vars(...)`; histogram
#' panels are created for observed group/stratum combinations.
#'
#' @usage
#' ghist(
#'   data = NULL, x = NULL, vars = NULL, by = NULL, bins = "Sturges",
#'   density = FALSE, normal = FALSE, xlab = NULL, ylab = NULL, xtitle = NULL,
#'   ytitle = NULL, xbreaks = NULL, ybreaks = NULL, title = NULL,
#'   subtitle = NULL, note = NULL, color = NULL, palette = "default",
#'   alpha = 0.85, border_color = "white", normal_color = "black",
#'   normal_lty = 1, normal_lwd = 2, xline = NULL, yline = NULL,
#'   ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal",
#'   size = 11, combine = FALSE, ncol = NULL, file = NULL, width = 7, height = 5,
#'   dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL
#' )
#'
#' @inheritParams gbar
#' @param bins Number of bins, a vector of break points, or a valid value for `graphics::hist()`.
#' @param density If `TRUE`, the vertical axis shows density rather than counts.
#' @param normal Add a fitted normal density curve.
#' @param xbreaks Numeric x-axis tick positions used with `xlab`.
#'
#' @param border_color Histogram-bar border colour.
#' @param normal_color,normal_lty,normal_lwd Colour, line type, and width of the optional normal-reference curve.
#' @return An object of class `r4vn_graph`; its `data` component contains histogram breaks, counts, density, and midpoints.
#' @examples
#' d <- data.frame(age = c(18, 21, 25, 27, 31, 34, 38, 45, 51, 62))
#' ghist(d, x = age)
#' ghist(d, x = age, bins = 5, normal = TRUE, color = "steelblue")
#' \donttest{
#' d$sex <- rep(c("Female", "Male"), length.out = nrow(d))
#' ghist(d, x = age, by = sex, normal = TRUE, xline = 40, ref_lty = 2)
#' ghist(d, vars = vars(age), by = vars(sex), normal = TRUE, combine = TRUE)
#' }
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(age = c(18, 21, 25, 27, 31, 34, 38, 45, 51, 62))
#' ghist(d, x = age, show = FALSE)
#' ghist(d, x = age, bins = 5, show = FALSE)
#' ghist(d, x = age, density = TRUE, normal = TRUE, show = FALSE)
#' }
#' @export
ghist <- function(data = NULL, x, bins = "Sturges", density = FALSE, normal = FALSE, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = NULL, xbreaks = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 0.85, border_color = "white", normal_color = "black", normal_lty = 1, normal_lwd = 2, xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); xv <- .r4vn_graph_eval_var(xe, data, env, "x")
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  if (!is.numeric(xv)) stop("`x` must be numeric.", call. = FALSE); xv <- xv[is.finite(xv)]; if (!length(xv)) stop("No finite observations are available.", call. = FALSE)
  br <- if (is.numeric(bins) && length(bins) == 1L) pretty(range(xv), n = bins) else bins
  h <- graphics::hist(xv, breaks = br, plot = FALSE); col <- .r4vn_colors(1, color, palette, alpha)
  xt <- .r4vn_var_title(xe, data, xtitle); yt <- if (is.null(ytitle)) if (density) "Density" else "Count" else ytitle
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE)
    graphics::plot(h, freq = !density, col = col, border = border_color, axes = FALSE, xlab = xt, ylab = yt, main = title)
    .r4vn_axis(1, xv, xlab, xbreaks); .r4vn_axis(2, if (density) h$density else h$counts, ylab, ybreaks); graphics::box(bty = graphics::par("bty"))
    if (normal) { xx <- seq(min(xv), max(xv), length.out = 300); yy <- stats::dnorm(xx, mean(xv), stats::sd(xv)); if (!density) yy <- yy * length(xv) * diff(h$breaks)[1L]; graphics::lines(xx, yy, col = normal_color, lty = normal_lty, lwd = normal_lwd) }
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg)
  out <- data.frame(left = head(h$breaks, -1), right = tail(h$breaks, -1), midpoint = h$mids, count = h$counts, density = h$density)
  .r4vn_graph_result("histogram", out, call, file, draw = draw)
}

#' Box plot
#'
#' Draws one or several numeric distributions overall or across categories.
#' `vars()` can request several numeric outcomes; hierarchical `by` is supported.
#'
#' @usage
#' gbox(
#'   data = NULL, x = NULL, y = NULL, vars = NULL, by = NULL, horizontal = FALSE,
#'   points = FALSE, outliers = TRUE, xlab = NULL, ylab = NULL, xtitle = NULL,
#'   ytitle = NULL, xbreaks = NULL, ybreaks = NULL, title = NULL,
#'   subtitle = NULL, note = NULL, color = NULL, palette = "default",
#'   alpha = 0.7, border_color = "gray30", point_color = "black",
#'   point_alpha = 0.45, point_size = 0.55, point_pch = 16, xline = NULL,
#'   yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1,
#'   theme = "journal", size = 11, combine = FALSE, ncol = NULL, file = NULL,
#'   width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL,
#'   hline = NULL
#' )
#'
#' @inheritParams gbar
#' @param y Numeric outcome variable.
#' @param x Optional categorical grouping variable.
#' @param horizontal Draw horizontal boxes.
#' @param points Add lightly jittered observations.
#' @param outliers Show conventional box-plot outliers.
#' @param xbreaks,ybreaks Numeric tick positions used with `xlab` and `ylab`.
#'
#' @param border_color Box/whisker border colour.
#' @param point_color,point_alpha,point_size,point_pch Colour, transparency, size, and point symbol for overlaid raw observations.
#' @return An object of class `r4vn_graph`; its `data` component contains group sample sizes and five-number summaries.
#' @examples
#' d <- data.frame(sex = factor(c("Male", "Female", "Female", "Male")), bmi = c(22, 24, 27, 21))
#' gbox(d, y = bmi)
#' gbox(d, x = sex, y = bmi, points = TRUE)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(sex = factor(c("Male", "Female", "Female", "Male")),
#'                 bmi = c(22, 24, 27, 21))
#' gbox(d, y = bmi, show = FALSE)
#' gbox(d, x = sex, y = bmi, points = TRUE, show = FALSE)
#' gbox(d, x = sex, y = bmi, horizontal = TRUE, outliers = FALSE, show = FALSE)
#' }
#' @export
gbox <- function(data = NULL, x = NULL, y, horizontal = FALSE, points = FALSE, outliers = TRUE, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = NULL, xbreaks = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 0.7, border_color = "gray30", point_color = "black", point_alpha = 0.45, point_size = 0.55, point_pch = 16, xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); ye <- substitute(y); xv <- .r4vn_graph_eval_var(xe, data, env, "x", TRUE); yv <- .r4vn_graph_eval_var(ye, data, env, "y")
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  if (!is.numeric(yv)) stop("`y` must be numeric.", call. = FALSE)
  keep <- is.finite(yv)
  if (!is.null(xv)) keep <- keep & !is.na(xv)
  yv <- yv[keep]
  if (is.null(xv)) { xf <- factor(rep("All", length(yv))); xl <- if (is.null(xlab)) "All" else as.character(xlab)[1L] } else { xf <- .r4vn_factor(xv[keep]); xl <- .r4vn_graph_labels(levels(xf), xlab) }
  if (!length(yv)) stop("No complete observations are available.", call. = FALSE); cols <- .r4vn_colors(nlevels(xf), color, palette, alpha)
  xt <- if (is.null(xv)) if (is.null(xtitle)) "" else xtitle else .r4vn_var_title(xe, data, xtitle); yt <- .r4vn_var_title(ye, data, ytitle)
  spl <- split(yv, xf, drop = TRUE); out <- do.call(rbind, lapply(names(spl), function(z) { q <- stats::quantile(spl[[z]], c(0, .25, .5, .75, 1), na.rm = TRUE, names = FALSE); data.frame(group = z, n = length(spl[[z]]), min = q[1], q1 = q[2], median = q[3], q3 = q[4], max = q[5]) }))
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE)
    category_labels <- if (horizontal && !is.null(ylab)) ylab else xl
    graphics::boxplot(yv ~ xf, names = rep("", nlevels(xf)), col = cols, border = border_color, outline = outliers, horizontal = horizontal, axes = FALSE, xlab = if (horizontal) yt else xt, ylab = if (horizontal) xt else yt, main = title)
    if (horizontal) {
      .r4vn_axis(1, yv, xlab, xbreaks); graphics::axis(2, at = seq_len(nlevels(xf)), labels = category_labels, tick = FALSE)
    } else {
      graphics::axis(1, at = seq_len(nlevels(xf)), labels = category_labels); .r4vn_axis(2, yv, ylab, ybreaks)
    }
    graphics::box(bty = graphics::par("bty"))
    if (points) {
      pos <- as.numeric(xf) + ((seq_along(yv) %% 9L) - 4L) * 0.025
      if (horizontal) graphics::points(yv, pos, pch = point_pch, cex = point_size, col = grDevices::adjustcolor(point_color, point_alpha)) else graphics::points(pos, yv, pch = point_pch, cex = point_size, col = grDevices::adjustcolor(point_color, point_alpha))
    }
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg)
  .r4vn_graph_result("box", out, call, file, draw = draw)
}

#' Scatter plot
#'
#' Draws one x variable against one or several y variables. Hierarchical `by`
#' uses all but the last variable as strata and the last variable as the plotted
#' grouping variable.
#'
#' @usage
#' gscatter(
#'   data = NULL, x, y = NULL, vars = NULL, by = NULL, fit = FALSE,
#'   fit_color = NULL, fit_lty = 1, fit_lwd = 2, cor = FALSE, pch = 16,
#'   point_size = 1, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = NULL,
#'   xbreaks = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL,
#'   color = NULL, palette = "default", alpha = 0.75, legend = TRUE,
#'   legend_position = "topright", xline = NULL, yline = NULL,
#'   ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal",
#'   size = 11, combine = FALSE, ncol = NULL, file = NULL, width = 7, height = 5,
#'   dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL
#' )
#'
#' @description
#' Draws the relationship between two numeric variables, optionally colored by a group and with fitted lines.
#'
#' @inheritParams gbar
#' @param fit `FALSE`, `TRUE`, `"linear"`, or `"loess"`.
#' @param cor Add the Pearson correlation coefficient to the graph.
#' @param pch Point symbol.
#' @param point_size Point-size multiplier.
#' @param xbreaks,ybreaks Numeric tick positions used with `xlab` and `ylab`.
#'
#' @param fit_color,fit_lty,fit_lwd Colour, line type, and line width for the fitted line. `fit_color = NULL` follows the point/group colour.
#' @return An object of class `r4vn_graph`; its `data` component contains complete plotted observations.
#' @examples
#' d <- data.frame(
#'   age = c(22, 28, 35, 41, 55),
#'   bmi = c(20, 23, 25, 27, 29),
#'   sex = c("M", "F", "F", "M", "F")
#' )
#' gscatter(d, x = age, y = bmi)
#' gscatter(d, x = age, y = bmi, by = sex, fit = "linear", cor = TRUE)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(age = c(22, 28, 35, 41, 55),
#'                 bmi = c(20, 23, 25, 27, 29),
#'                 sex = c("M", "F", "F", "M", "F"))
#' gscatter(d, x = age, y = bmi, show = FALSE)
#' gscatter(d, x = age, y = bmi, fit = "linear", cor = TRUE, show = FALSE)
#' gscatter(d, x = age, y = bmi, by = sex, fit = "linear", show = FALSE)
#' gscatter(d, x = age, y = bmi, fit = "loess", show = FALSE)
#' }
#' @export
gscatter <- function(data = NULL, x, y, by = NULL, fit = FALSE, fit_color = NULL, fit_lty = 1, fit_lwd = 2, cor = FALSE, pch = 16, point_size = 1, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = NULL, xbreaks = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 0.75, legend = TRUE, legend_position = "topright", xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); ye <- substitute(y); be <- substitute(by)
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  xv <- .r4vn_graph_eval_var(xe, data, env, "x"); yv <- .r4vn_graph_eval_var(ye, data, env, "y"); bv <- .r4vn_graph_eval_var(be, data, env, "by", TRUE)
  if (!is.numeric(xv) || !is.numeric(yv)) stop("`x` and `y` must be numeric.", call. = FALSE)
  keep <- is.finite(xv) & is.finite(yv)
  if (!is.null(bv)) keep <- keep & !is.na(bv)
  xv <- xv[keep]; yv <- yv[keep]; if (!length(xv)) stop("No complete observations are available.", call. = FALSE)
  bf <- if (is.null(bv)) factor(rep("All", length(xv))) else .r4vn_factor(bv[keep]); cols <- .r4vn_colors(nlevels(bf), color, palette, alpha); pcols <- cols[as.numeric(bf)]; fit_cols <- if (is.null(fit_color)) .r4vn_colors(nlevels(bf), color, palette, 1) else rep(as.character(fit_color), length.out = nlevels(bf))
  fit <- if (isTRUE(fit)) "linear" else if (identical(fit, FALSE)) "none" else match.arg(tolower(as.character(fit)[1L]), c("none", "linear", "loess"))
  if (is.null(bv)) {
    out <- data.frame(
      x = xv,
      y = yv,
      stringsAsFactors = FALSE
    )
  } else {
    out <- data.frame(
      x = xv,
      y = yv,
      by = as.character(bf),
      stringsAsFactors = FALSE
    )
  }
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE)
    graphics::plot(xv, yv, type = "n", axes = FALSE, xlab = .r4vn_var_title(xe, data, xtitle), ylab = .r4vn_var_title(ye, data, ytitle), main = title)
    .r4vn_axis(1, xv, xlab, xbreaks); .r4vn_axis(2, yv, ylab, ybreaks); graphics::box(bty = graphics::par("bty")); graphics::points(xv, yv, pch = pch, cex = point_size, col = pcols)
    if (fit != "none") {
      for (i in seq_len(nlevels(bf))) {
        z <- as.numeric(bf) == i
        need <- if (fit == "linear") 2L else 4L
        if (sum(z) >= need) {
          if (fit == "linear") graphics::abline(stats::lm(yv[z] ~ xv[z]), col = fit_cols[i], lty = rep(fit_lty, length.out = nlevels(bf))[i], lwd = rep(fit_lwd, length.out = nlevels(bf))[i]) else {
            dd <- data.frame(x = xv[z], y = yv[z]); m <- stats::loess(y ~ x, data = dd)
            xx <- seq(min(dd$x), max(dd$x), length.out = 200)
            graphics::lines(xx, stats::predict(m, newdata = data.frame(x = xx)), col = fit_cols[i], lty = rep(fit_lty, length.out = nlevels(bf))[i], lwd = rep(fit_lwd, length.out = nlevels(bf))[i])
          }
        }
      }
    }
    if (isTRUE(cor)) { r <- stats::cor(xv, yv, use = "complete.obs"); graphics::legend("topleft", legend = sprintf("r = %.2f", r), bty = "n", cex = size / 12) }
    if (!is.null(bv) && isTRUE(legend)) graphics::legend(legend_position, legend = levels(bf), title = .r4vn_var_title(be, data), col = if (fit == "none") cols else fit_cols, pch = pch, lty = if (fit == "none") NA else fit_lty, lwd = if (fit == "none") NA else fit_lwd, bty = "n", cex = size / 12)
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg)
  .r4vn_graph_result("scatter", out, call, file, draw = draw)
}

#' Line chart
#'
#' Draws one x variable against one or several y variables with optional
#' hierarchical grouping.
#'
#' @usage
#' gline(
#'   data = NULL, x, y = NULL, vars = NULL, by = NULL,
#'   stat = c("identity", "mean", "median"), points = TRUE, line_width = 2,
#'   line_type = 1, sort = TRUE, pch = 16, point_size = 0.9, xlab = NULL,
#'   ylab = NULL, xtitle = NULL, ytitle = NULL, xbreaks = NULL, ybreaks = NULL,
#'   title = NULL, subtitle = NULL, note = NULL, color = NULL,
#'   palette = "default", alpha = 1, legend = TRUE, legend_position = "topright",
#'   xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1,
#'   theme = "journal", size = 11, combine = FALSE, ncol = NULL, file = NULL,
#'   width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL,
#'   hline = NULL
#' )
#'
#' @description
#' Draws an ordered trend for one numeric outcome, optionally with separate lines by group.
#'
#' @inheritParams gscatter
#' @param stat `"identity"`, `"mean"`, or `"median"`. Mean or median collapses repeated x values within each group.
#' @param points Show points along each line.
#' @param line_width,line_type Width and line type of connecting lines.
#' @param sort Sort observations by x within each line.
#' @return An object of class `r4vn_graph`; its `data` component contains the plotted or aggregated values.
#' @examples
#' d <- data.frame(
#'   year = rep(2022:2024, 2),
#'   rate = c(12, 15, 18, 10, 13, 17),
#'   sex = rep(c("Male", "Female"), each = 3)
#' )
#' gline(d, x = year, y = rate)
#' gline(d, x = year, y = rate, by = sex, points = TRUE)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(year = rep(2022:2024, 2),
#'                 rate = c(12, 15, 18, 10, 13, 17),
#'                 sex = rep(c("Male", "Female"), each = 3))
#' gline(d, x = year, y = rate, show = FALSE)
#' gline(d, x = year, y = rate, by = sex, points = TRUE, show = FALSE)
#'
#' # Collapse repeated x values to means or medians
#' d2 <- rbind(d, transform(d, rate = rate + 2))
#' gline(d2, x = year, y = rate, by = sex, stat = "mean", show = FALSE)
#' }
#' @export
gline <- function(data = NULL, x, y, by = NULL, stat = c("identity", "mean", "median"), points = TRUE, line_width = 2, line_type = 1, sort = TRUE, pch = 16, point_size = 0.9, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = NULL, xbreaks = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 1, legend = TRUE, legend_position = "topright", xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); ye <- substitute(y); be <- substitute(by); xv <- .r4vn_graph_eval_var(xe, data, env, "x"); yv <- .r4vn_graph_eval_var(ye, data, env, "y"); bv <- .r4vn_graph_eval_var(be, data, env, "by", TRUE)
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  if (!is.numeric(yv)) stop("`y` must be numeric.", call. = FALSE)
  if (!(is.numeric(xv) || inherits(xv, "Date") || inherits(xv, "POSIXt"))) stop("`x` must be numeric, Date, or POSIXt.", call. = FALSE)
  keep <- !is.na(xv) & is.finite(yv)
  if (!is.null(bv)) keep <- keep & !is.na(bv)
  xv <- xv[keep]; yv <- yv[keep]; bf <- if (is.null(bv)) factor(rep("All", length(yv))) else .r4vn_factor(bv[keep]); stat <- match.arg(stat)
  work <- data.frame(x = xv, y = yv, by = bf, stringsAsFactors = FALSE)
  if (stat != "identity") { f <- if (stat == "mean") mean else stats::median; work <- stats::aggregate(y ~ x + by, work, f, na.rm = TRUE) }
  if (sort) work <- work[order(work$by, work$x), , drop = FALSE]; cols <- .r4vn_colors(nlevels(work$by), color, palette, alpha)
  line_types <- rep(line_type, length.out = nlevels(work$by))
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE)
    graphics::plot(work$x, work$y, type = "n", axes = FALSE, xlab = .r4vn_var_title(xe, data, xtitle), ylab = .r4vn_var_title(ye, data, ytitle), main = title)
    .r4vn_axis(1, if (is.numeric(work$x)) work$x else seq_len(nrow(work)), xlab, xbreaks); .r4vn_axis(2, work$y, ylab, ybreaks); graphics::box(bty = graphics::par("bty"))
    for (i in seq_len(nlevels(work$by))) { z <- work$by == levels(work$by)[i]; graphics::lines(work$x[z], work$y[z], col = cols[i], lwd = line_width, lty = line_types[i]); if (points) graphics::points(work$x[z], work$y[z], col = cols[i], pch = pch, cex = point_size) }
    if (!is.null(bv) && isTRUE(legend)) graphics::legend(legend_position, legend = levels(work$by), title = .r4vn_var_title(be, data), col = cols, lwd = line_width, lty = line_types, pch = if (points) pch else NA, bty = "n", cex = size / 12)
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg)
  out <- work
  out$by <- if (is.null(bv)) NULL else as.character(out$by)
  .r4vn_graph_result("line", out, call, file, draw = draw)
}

#' Density plot
#'
#' Draws densities for one or several numeric variables with optional
#' hierarchical grouping.
#'
#' @usage
#' gdensity(
#'   data = NULL, x = NULL, vars = NULL, by = NULL, adjust = 1, fill = FALSE,
#'   line_width = 2, line_type = 1, xlab = NULL, ylab = NULL, xtitle = NULL,
#'   ytitle = "Density", xbreaks = NULL, ybreaks = NULL, title = NULL,
#'   subtitle = NULL, note = NULL, color = NULL, palette = "default",
#'   alpha = 0.35, legend = TRUE, legend_position = "topright", xline = NULL,
#'   yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1,
#'   theme = "journal", size = 11, combine = FALSE, ncol = NULL, file = NULL,
#'   width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL,
#'   hline = NULL
#' )
#'
#' @description
#' Draws a kernel density estimate overall or by a categorical variable.
#'
#' @inheritParams gscatter
#' @param adjust Bandwidth adjustment passed to `stats::density()`.
#' @param fill Fill the area under each curve.
#'
#' @param line_width,line_type Width and line type of density curves.
#' @return An object of class `r4vn_graph`; its `data` component contains density coordinates.
#' @examples
#' d <- data.frame(age = c(18, 21, 25, 27, 31, 34, 38, 45, 51, 62), sex = rep(c("M", "F"), 5))
#' gdensity(d, x = age)
#' gdensity(d, x = age, by = sex, fill = TRUE)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(age = c(18, 21, 25, 27, 31, 34, 38, 45, 51, 62),
#'                 sex = rep(c("M", "F"), 5))
#' gdensity(d, x = age, show = FALSE)
#' gdensity(d, x = age, by = sex, show = FALSE)
#' gdensity(d, x = age, by = sex, fill = TRUE, adjust = 1.2, show = FALSE)
#' }
#' @export
gdensity <- function(data = NULL, x, by = NULL, adjust = 1, fill = FALSE, line_width = 2, line_type = 1, xlab = NULL, ylab = NULL, xtitle = NULL, ytitle = "Density", xbreaks = NULL, ybreaks = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 0.35, legend = TRUE, legend_position = "topright", xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); be <- substitute(by); xv <- .r4vn_graph_eval_var(xe, data, env, "x"); bv <- .r4vn_graph_eval_var(be, data, env, "by", TRUE)
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  if (!is.numeric(xv)) stop("`x` must be numeric.", call. = FALSE)
  keep <- is.finite(xv)
  if (!is.null(bv)) keep <- keep & !is.na(bv)
  xv <- xv[keep]; bf <- if (is.null(bv)) factor(rep("All", length(xv))) else .r4vn_factor(bv[keep]); if (!length(xv)) stop("No complete observations are available.", call. = FALSE)
  dens <- lapply(split(xv, bf, drop = TRUE), function(z) { if (length(unique(z)) < 2L) stop("Each density group needs at least two distinct values.", call. = FALSE); stats::density(z, adjust = adjust, na.rm = TRUE) })
  line_cols <- .r4vn_colors(length(dens), color, palette, 1); fill_cols <- grDevices::adjustcolor(line_cols, alpha.f = alpha)
  out <- do.call(rbind, Map(function(d, g) data.frame(x = d$x, density = d$y, by = g), dens, names(dens)))
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE); xr <- range(vapply(dens, function(z) range(z$x), numeric(2))); yr <- c(0, max(vapply(dens, function(z) max(z$y), numeric(1))))
    graphics::plot(xr, yr, type = "n", axes = FALSE, xlab = .r4vn_var_title(xe, data, xtitle), ylab = ytitle, main = title)
    .r4vn_axis(1, xv, xlab, xbreaks); .r4vn_axis(2, unlist(lapply(dens, `[[`, "y")), ylab, ybreaks); graphics::box(bty = graphics::par("bty"))
    for (i in seq_along(dens)) { d <- dens[[i]]; if (fill) graphics::polygon(c(d$x, rev(d$x)), c(d$y, rep(0, length(d$y))), col = fill_cols[i], border = NA); graphics::lines(d$x, d$y, col = line_cols[i], lwd = line_width, lty = rep(line_type, length.out = length(dens))[i]) }
    if (!is.null(bv) && isTRUE(legend)) graphics::legend(legend_position, legend = names(dens), title = .r4vn_var_title(be, data), col = line_cols, lwd = line_width, lty = line_type, bty = "n", cex = size / 12)
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg); .r4vn_graph_result("density", out, call, file, draw = draw)
}

#' Pie or donut chart
#'
#' Draws one or several categorical variables; `by` creates separate charts for
#' group/stratum combinations.
#'
#' @usage
#' gpie(
#'   data = NULL, x = NULL, vars = NULL, by = NULL, donut = FALSE, label = TRUE,
#'   percent = TRUE, digits = 1, xlab = NULL, title = NULL, subtitle = NULL,
#'   note = NULL, color = NULL, palette = "default", alpha = 1,
#'   border_color = "white", border_lwd = 1, clockwise = TRUE, missing = FALSE,
#'   missing_label = "Missing", theme = "journal", size = 11, combine = FALSE,
#'   ncol = NULL, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE,
#'   bg = "white"
#' )
#'
#' @description
#' Draws the distribution of a categorical variable as a pie or donut chart. Bar charts are usually preferable when there are many categories.
#'
#' @inheritParams gbar
#' @param donut Draw a donut chart instead of a conventional pie.
#' @param label Show category labels.
#' @param percent Add percentages to labels.
#' @param digits Number of percentage decimal places.
#' @param clockwise Draw slices clockwise.
#'
#' @param border_color,border_lwd Slice-border colour and line width.
#' @return An object of class `r4vn_graph`; its `data` component contains counts and percentages.
#' @examples
#' d <- data.frame(group = c("A", "A", "B", "B", "B", "C"))
#' gpie(d, x = group)
#' gpie(d, x = group, donut = TRUE, palette = "journal")
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(group = c("A", "A", "B", "B", "B", "C"))
#' gpie(d, x = group, show = FALSE)
#' gpie(d, x = group, donut = TRUE, palette = "journal", show = FALSE)
#' gpie(d, x = group, label = TRUE, percent = FALSE, show = FALSE)
#' }
#' @export
gpie <- function(data = NULL, x, donut = FALSE, label = TRUE, percent = TRUE, digits = 1, xlab = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "default", alpha = 1, border_color = "white", border_lwd = 1, clockwise = TRUE, missing = FALSE, missing_label = "Missing", theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white") {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); xe <- substitute(x); xv <- .r4vn_graph_eval_var(xe, data, env, "x"); xf <- .r4vn_factor(xv, missing, missing_label); xf <- droplevels(xf[!is.na(xf)]); if (!length(xf)) stop("No observations are available.", call. = FALSE)
  counts <- as.numeric(table(xf)); lev <- levels(xf); pct <- counts / sum(counts) * 100; labs <- .r4vn_graph_labels(lev, xlab); if (label && percent) labs <- sprintf(paste0("%s\n%.", digits, "f%%"), labs, pct) else if (!label) labs <- rep("", length(labs))
  cols <- .r4vn_colors(length(counts), color, palette, alpha); out <- data.frame(category = lev, count = counts, percent = pct, stringsAsFactors = FALSE)
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE); graphics::pie(counts, labels = labs, col = cols, border = border_color, lwd = border_lwd, clockwise = clockwise, main = title, cex = size / 12)
    if (donut) graphics::symbols(0, 0, circles = 0.45, inches = FALSE, add = TRUE, bg = bg, fg = bg)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg); .r4vn_graph_result(if (donut) "donut" else "pie", out, call, file, draw = draw)
}

#' Forest plot
#'
#' Draws estimates and confidence intervals on a linear or logarithmic scale. It is suitable for odds ratios, risk ratios, prevalence ratios, hazard ratios, and regression coefficients.
#'
#' @param data A data frame.
#' @param estimate Point estimate variable.
#' @param lower,upper Lower and upper confidence-limit variables.
#' @param label Row-label variable.
#' @param reference Reference value, commonly 1 for ratios and 0 for coefficients.
#' @param log Use a logarithmic horizontal axis.
#' @param sort Sort by estimate: `FALSE`, `TRUE`, `"ascending"`, or `"descending"`.
#' @param digits Number of displayed digits.
#' @param xtitle Horizontal-axis title.
#' @param title,subtitle,note Main title, subtitle, and note.
#' @param color Point and interval color.
#' @param palette Color palette used when `color = NULL`.
#' @param point_size Point-size multiplier.
#' @param line_width Confidence-interval line width.
#' @param reference_color,reference_lty,reference_lwd Color, line type, and width
#'   of the vertical reference line.
#' @param theme,size,file,width,height,dpi,show,bg See `gbar()`.
#'
#' @return An object of class `r4vn_graph`; its `data` component contains plotted rows.
#' @examples
#' d <- data.frame(
#'   term = c("Smoking", "Obesity", "Male"),
#'   or = c(1.8, 2.4, 1.2),
#'   lower = c(1.2, 1.5, 0.8),
#'   upper = c(2.7, 3.8, 1.8)
#' )
#' gforest(d, estimate = or, lower = lower, upper = upper, label = term)
#'
#' # Extended usage examples
#' \donttest{
#' # Ratio measures use reference = 1 and a logarithmic axis
#' d <- data.frame(
#'   term = c("Smoking", "Obesity", "Male"),
#'   estimate = c(1.80, 2.40, 1.20),
#'   lower = c(1.20, 1.50, 0.80),
#'   upper = c(2.70, 3.80, 1.80)
#' )
#' gforest(d, estimate, lower, upper, term, show = FALSE)
#' gforest(d, estimate, lower, upper, term,
#'         sort = "descending", title = "Adjusted odds ratios", show = FALSE)
#'
#' # Regression coefficients use reference = 0 and a linear axis
#' beta <- data.frame(term = c("Age", "BMI", "Male"),
#'                    estimate = c(0.12, 0.34, -0.18),
#'                    lower = c(0.04, 0.10, -0.45),
#'                    upper = c(0.20, 0.58, 0.09))
#' gforest(beta, estimate, lower, upper, term,
#'         reference = 0, log = FALSE, xtitle = "Regression coefficient",
#'         show = FALSE)
#'
#' # Export directly to a graphics file
#' gforest(d, estimate, lower, upper, term,
#'         file = tempfile(fileext = ".png"), show = FALSE)
#' }
#' @export
gforest <- function(data = NULL, estimate, lower, upper, label, reference = 1, log = TRUE, sort = FALSE, digits = 2, xtitle = NULL, title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "journal", point_size = 1.1, line_width = 2, reference_color = "gray50", reference_lty = 2, reference_lwd = 1, theme = "journal", size = 11, file = NULL, width = 7, height = 5, dpi = 300, show = TRUE, bg = "white") {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); ee <- substitute(estimate); le <- substitute(lower); ue <- substitute(upper); lae <- substitute(label)
  est <- .r4vn_graph_eval_var(ee, data, env, "estimate"); lo <- .r4vn_graph_eval_var(le, data, env, "lower"); hi <- .r4vn_graph_eval_var(ue, data, env, "upper"); lab <- .r4vn_graph_eval_var(lae, data, env, "label")
  if (!is.numeric(est) || !is.numeric(lo) || !is.numeric(hi)) stop("`estimate`, `lower`, and `upper` must be numeric.", call. = FALSE)
  keep <- is.finite(est) & is.finite(lo) & is.finite(hi) & !is.na(lab); out <- data.frame(label = as.character(lab[keep]), estimate = est[keep], lower = lo[keep], upper = hi[keep], stringsAsFactors = FALSE)
  if (!nrow(out)) stop("No complete forest-plot rows are available.", call. = FALSE)
  if (log && any(out$lower <= 0)) stop("All confidence limits must be positive when `log = TRUE`.", call. = FALSE)
  mode <- if (isTRUE(sort)) "ascending" else if (identical(sort, FALSE)) "none" else match.arg(tolower(as.character(sort)[1L]), c("none", "ascending", "descending")); if (mode != "none") out <- out[order(out$estimate, decreasing = mode == "descending"), , drop = FALSE]
  out <- out[nrow(out):1, , drop = FALSE]; yy <- seq_len(nrow(out)); col <- .r4vn_colors(1, color, palette, 1); if (is.null(xtitle)) xtitle <- if (log) "Effect estimate (95% CI)" else "Estimate (95% CI)"
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE); graphics::par(mar = c(if (is.null(note)) 4.2 else 5.2, max(5, min(12, max(nchar(out$label)) * 0.13 + 2)), 3.2, 7.5))
    graphics::plot(out$estimate, yy, log = if (log) "x" else "", xlim = range(c(out$lower, out$upper, reference)), ylim = c(0.5, nrow(out) + 0.5), yaxt = "n", xlab = xtitle, ylab = "", pch = 16, cex = point_size, col = col, main = title)
    graphics::axis(2, at = yy, labels = out$label, las = 1, tick = FALSE); graphics::abline(v = reference, lty = reference_lty, lwd = reference_lwd, col = reference_color); graphics::segments(out$lower, yy, out$upper, yy, col = col, lwd = line_width); graphics::points(out$estimate, yy, pch = 16, cex = point_size, col = col)
    txt <- sprintf(paste0("%.", digits, "f (%.", digits, "f-%.", digits, "f)"), out$estimate, out$lower, out$upper); graphics::mtext(txt, side = 4, at = yy, las = 1, line = 0.2, cex = size / 13)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg); .r4vn_graph_result("forest", out[nrow(out):1, , drop = FALSE], call, file, draw = draw)
}

#' ROC curve
#'
#' Draws ROC curves for one or several predictor/score variables. `by` can create
#' ROC analyses within hierarchical strata.
#'
#' @usage
#' groc(
#'   data = NULL, outcome, pred = NULL, vars = NULL, by = NULL, event = NULL,
#'   diagonal = TRUE, auc = TRUE, digits = 3, curve_lty = 1, curve_lwd = 2.5,
#'   diagonal_color = "gray60", diagonal_lty = 2, diagonal_lwd = 1, xlab = NULL,
#'   ylab = NULL, xtitle = "1 - Specificity", ytitle = "Sensitivity",
#'   title = NULL, subtitle = NULL, note = NULL, color = NULL,
#'   palette = "journal", xline = NULL, yline = NULL, ref_color = "gray40",
#'   ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, combine = FALSE,
#'   ncol = NULL, file = NULL, width = 6, height = 6, dpi = 300, show = TRUE,
#'   bg = "white", vline = NULL, hline = NULL
#' )
#'
#' @description
#' Calculates and draws a receiver operating characteristic curve from a binary outcome and numeric predicted probabilities or scores. No external package is required.
#'
#' @param data A data frame.
#' @param outcome Binary outcome variable.
#' @param pred Numeric predicted probability or score; larger values must indicate a greater probability of the event.
#' @param vars Optional `vars(...)` selector for several numeric predictors or
#'   scores.
#' @param by Optional grouping variable or hierarchical `vars(...)` selector.
#' @param event Event value. By default, the second factor level or the larger numeric value is used.
#' @param diagonal Show the no-discrimination diagonal.
#' @param auc Show the area under the curve.
#' @param digits Number of AUC digits.
#' @param xlab,ylab Optional tick labels.
#' @param xtitle,ytitle Axis titles.
#' @param xline,yline Optional numeric reference lines on the x and y axes.
#' @param vline,hline Deprecated aliases for `xline` and `yline`.
#' @param ref_color,ref_lty,ref_lwd Color, line type, and width for reference
#'   lines.
#' @param title,subtitle,note,color,palette,theme,size,combine,ncol,file,width,height,dpi,show,bg See `gbar()`.
#'
#' @param curve_lty,curve_lwd ROC-curve line type and width.
#' @param diagonal_color,diagonal_lty,diagonal_lwd Colour, line type, and width of the no-discrimination diagonal.
#' @return An object of class `r4vn_graph`; its `data` component contains thresholds, sensitivity, and specificity, and its `auc` attribute contains the AUC.
#' @examples
#' d <- data.frame(y = c(0, 0, 1, 1, 1), p = c(.10, .35, .40, .75, .90))
#' groc(d, outcome = y, pred = p, event = 1)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(
#'   outcome = factor(c("No", "No", "No", "Yes", "Yes", "Yes", "Yes")),
#'   probability = c(.05, .20, .35, .40, .65, .80, .95)
#' )
#'
#' # ROC curve with explicit event
#' roc1 <- groc(d, outcome, probability, event = "Yes", show = FALSE)
#' attr(roc1$data, "auc")
#'
#' # Hide the diagonal or AUC annotation and customize labels
#' groc(d, outcome, probability, event = "Yes",
#'      diagonal = FALSE, auc = FALSE,
#'      xtitle = "False-positive rate", ytitle = "True-positive rate",
#'      show = FALSE)
#'
#' # Numeric binary outcome; the larger value is the default event
#' d2 <- data.frame(y = c(0, 0, 1, 1, 1), score = c(.10, .35, .40, .75, .90))
#' groc(d2, y, score, show = FALSE)
#'
#' # Export the ROC curve
#' groc(d, outcome, probability, event = "Yes",
#'      file = tempfile(fileext = ".pdf"), show = FALSE)
#' }
#' @export
groc <- function(data = NULL, outcome, pred, event = NULL, diagonal = TRUE, auc = TRUE, digits = 3, curve_lty = 1, curve_lwd = 2.5, diagonal_color = "gray60", diagonal_lty = 2, diagonal_lwd = 1, xlab = NULL, ylab = NULL, xtitle = "1 - Specificity", ytitle = "Sensitivity", title = NULL, subtitle = NULL, note = NULL, color = NULL, palette = "journal", xline = NULL, yline = NULL, ref_color = "gray40", ref_lty = 2, ref_lwd = 1, theme = "journal", size = 11, file = NULL, width = 6, height = 6, dpi = 300, show = TRUE, bg = "white", vline = NULL, hline = NULL) {
  call <- match.call(); env <- parent.frame(); data <- .r4vn_get_data(data); oe <- substitute(outcome); pe <- substitute(pred); y <- .r4vn_graph_eval_var(oe, data, env, "outcome"); p <- .r4vn_graph_eval_var(pe, data, env, "pred")
  refs <- .r4vn_reference_lines(xline, yline, vline, hline)
  if (!is.numeric(p)) stop("`pred` must be numeric.", call. = FALSE); keep <- !is.na(y) & is.finite(p); y <- y[keep]; p <- p[keep]; vals <- unique(y)
  if (length(vals) != 2L) stop("`outcome` must have exactly two observed values.", call. = FALSE)
  if (is.null(event)) event <- if (is.factor(y)) levels(droplevels(y))[2L] else sort(vals)[2L]
  yy <- as.integer(as.character(y) == as.character(event)); if (!any(yy == 1L) || !any(yy == 0L)) stop("`event` does not define a valid binary outcome.", call. = FALSE)
  ord <- order(p, decreasing = TRUE); yy <- yy[ord]; pp <- p[ord]; tp <- cumsum(yy); fp <- cumsum(1L - yy); pos <- sum(yy); neg <- length(yy) - pos
  idx <- c(which(!duplicated(pp, fromLast = TRUE)), length(pp)); idx <- sort(unique(idx)); sens <- c(0, tp[idx] / pos, 1); fpr <- c(0, fp[idx] / neg, 1); thresholds <- c(Inf, pp[idx], -Inf); sp <- 1 - fpr
  ord2 <- order(fpr, sens); fpr <- fpr[ord2]; sens <- sens[ord2]; sp <- sp[ord2]; thresholds <- thresholds[ord2]
  auc_value <- sum(diff(fpr) * (head(sens, -1) + tail(sens, -1)) / 2); out <- data.frame(threshold = thresholds, sensitivity = sens, specificity = sp, false_positive_rate = fpr); attr(out, "auc") <- auc_value; col <- .r4vn_colors(1, color, palette, 1)
  draw <- function() {
    old <- .r4vn_theme(theme, size, note); on.exit(graphics::par(old), add = TRUE); graphics::par(pty = "s")
    graphics::plot(fpr, sens, type = "l", lwd = curve_lwd, lty = curve_lty, col = col, xlim = c(0, 1), ylim = c(0, 1), xaxs = "i", yaxs = "i", axes = FALSE, xlab = xtitle, ylab = ytitle, main = title)
    graphics::axis(1, at = seq(0, 1, .2), labels = if (is.null(xlab)) seq(0, 1, .2) else xlab); graphics::axis(2, at = seq(0, 1, .2), labels = if (is.null(ylab)) seq(0, 1, .2) else ylab); graphics::box(bty = graphics::par("bty")); if (diagonal) graphics::abline(0, 1, lty = diagonal_lty, lwd = diagonal_lwd, col = diagonal_color)
    if (auc) graphics::legend("bottomright", legend = sprintf(paste0("AUC = %.", digits, "f"), auc_value), bty = "n", cex = size / 12)
    .r4vn_add_reference_lines(xline = refs$xline, yline = refs$yline, color = ref_color, lty = ref_lty, lwd = ref_lwd)
    .r4vn_add_titles(subtitle, note, size)
  }
  .r4vn_render(draw, file, show, width, height, dpi, bg); z <- .r4vn_graph_result("ROC", out, call, file, draw = draw); z$auc <- auc_value; z
}