#' Built-in Candlestick Pattern Names
#'
#' Returns supported pattern identifiers, Chinese names, or both.
#'
#' @param language Output language: `"id"`, `"cn"`, or `"both"`.
#'
#' @return A character vector of supported pattern names.
#'
#' @examples
#' available_patterns()
#' available_patterns("cn")
#' @export
available_patterns <- function(language = c("id", "cn", "both")) {
  language <- match.arg(language)
  catalog <- pattern_catalog()
  if (language == "id") return(unique(catalog$pattern_id))
  if (language == "cn") return(unique(catalog$pattern_cn))
  unique(c(catalog$pattern_id, catalog$pattern_cn))
}

#' Official TongHuaShun Pattern Catalog
#'
#' Returns the full 68-pattern catalog grouped by the official menu categories.
#'
#' @return A data frame with `pattern_id`, `pattern_cn`, and `category`.
#'
#' @examples
#' tbl <- pattern_catalog()
#' nrow(tbl)
#' @export
pattern_catalog <- function() {
  if (exists("catalog", envir = .kline_cache, inherits = FALSE)) {
    return(get("catalog", envir = .kline_cache, inherits = FALSE))
  }

  path <- system.file("extdata", "pattern_catalog.csv", package = "klineR")
  if (!nzchar(path)) {
    path <- file.path("inst", "extdata", "pattern_catalog.csv")
  }
  txt <- readLines(path, warn = FALSE, encoding = "UTF-8")
  catalog <- utils::read.csv(
    text = enc2utf8(paste(txt, collapse = "\n")),
    stringsAsFactors = FALSE
  )

  expected_cols <- c("pattern_id", "pattern_cn", "category")
  if (!identical(names(catalog), expected_cols)) {
    stop("Invalid catalog structure in pattern_catalog.csv.", call. = FALSE)
  }
  if (nrow(catalog) < 68) {
    stop("Pattern catalog must contain at least 68 patterns.", call. = FALSE)
  }
  if (anyDuplicated(catalog$pattern_id)) {
    stop("Duplicate pattern_id values found in pattern catalog.", call. = FALSE)
  }

  assign("catalog", catalog, envir = .kline_cache)
  catalog
}

#' Detect a Candlestick or Structure Pattern
#'
#' Detects one built-in pattern from OHLCV data.
#'
#' @param data A data frame with at least `open`, `high`, `low`, `close`
#'   columns. Optional columns include `date` and `volume`.
#' @param pattern One value from [available_patterns()].
#' @param ... Additional parameters passed to the selected detector.
#'
#' @return A logical vector of length `nrow(data)`. `TRUE` marks rows where the
#'   pattern is detected.
#'
#' @examples
#' d <- demo_ohlcv(120)
#' hit <- detect_pattern(d, "double_bottom")
#' tail(hit, 3)
#' @export
detect_pattern <- function(data, pattern, ...) {
  d <- normalize_ohlcv(data)
  pattern_id <- resolve_pattern_id(pattern)
  detector <- get_pattern_detector(pattern_id)
  detector(d, ...)
}

#' Scan Multiple Patterns on a Single Symbol
#'
#' Runs several detectors and reports whether each one is present on the latest
#' candle.
#'
#' @param data A data frame with OHLCV columns.
#' @param patterns Character vector of pattern names.
#' @param ... Additional parameters passed to each detector.
#'
#' @return A data frame with columns `pattern`, `detected_latest`.
#'
#' @examples
#' d <- demo_ohlcv(120)
#' scan_patterns(d, patterns = c("doji", "hammer", "golden_pit"))
#' @export
scan_patterns <- function(data, patterns = available_patterns(), ...) {
  patterns <- unique(patterns)
  invalid <- patterns[!vapply(patterns, is_supported_pattern, logical(1))]
  if (length(invalid) > 0) {
    stop("Unsupported pattern(s): ", paste(invalid, collapse = ", "), call. = FALSE)
  }

  detected <- vapply(
    patterns,
    function(p) {
      out <- detect_pattern(data, p, ...)
      if (length(out) == 0) FALSE else isTRUE(out[length(out)])
    },
    logical(1)
  )

  data.frame(
    pattern = patterns,
    detected_latest = unname(detected),
    stringsAsFactors = FALSE
  )
}

#' Screen Symbols by a Pattern
#'
#' Applies one detector to many symbols.
#'
#' @param data_list Named list of OHLCV data frames.
#' @param pattern Pattern identifier from [available_patterns()].
#' @param latest_only If `TRUE`, keep symbols where the latest row is detected.
#'   If `FALSE`, keep symbols with at least one detection in their series.
#' @param ... Additional parameters passed to [detect_pattern()].
#'
#' @return A data frame with detected symbols and context columns.
#'
#' @examples
#' d1 <- demo_ohlcv(130, seed = 1)
#' d2 <- demo_ohlcv(130, seed = 2)
#' screen_symbols(
#'   list(SYMA = d1, SYMB = d2),
#'   pattern = "doji",
#'   latest_only = FALSE
#' )
#' @export
screen_symbols <- function(data_list, pattern, latest_only = TRUE, ...) {
  if (!is.list(data_list) || length(data_list) == 0) {
    stop("`data_list` must be a non-empty named list.", call. = FALSE)
  }
  if (is.null(names(data_list)) || any(names(data_list) == "")) {
    names(data_list) <- paste0("symbol_", seq_along(data_list))
  }

  rows <- lapply(seq_along(data_list), function(i) {
    symbol <- names(data_list)[i]
    d <- normalize_ohlcv(data_list[[i]])
    hit <- detect_pattern(d, pattern = pattern, ...)
    latest <- if (length(hit) == 0) FALSE else isTRUE(hit[length(hit)])
    any_hit <- any(hit)

    keep <- if (latest_only) latest else any_hit
    if (!keep) {
      return(NULL)
    }

    idx <- if (latest_only) nrow(d) else max(which(hit))
    data.frame(
      symbol = symbol,
      pattern = resolve_pattern_id(pattern),
      detected_index = idx,
      detected_date = if ("date" %in% names(d)) as.character(d$date[idx]) else NA_character_,
      close = d$close[idx],
      stringsAsFactors = FALSE
    )
  })

  out <- do.call(rbind, rows)
  if (is.null(out)) {
    return(data.frame(
      symbol = character(),
      pattern = character(),
      detected_index = integer(),
      detected_date = character(),
      close = numeric(),
      stringsAsFactors = FALSE
    ))
  }
  rownames(out) <- NULL
  out
}

#' Example OHLCV Data
#'
#' Produces reproducible synthetic OHLCV data for examples and tests.
#'
#' @param n Number of rows to generate.
#' @param seed Random seed.
#'
#' @return A data frame with `date`, `open`, `high`, `low`, `close`, `volume`.
#'
#' @examples
#' d <- demo_ohlcv(60, seed = 99)
#' head(d, 3)
#' @export
demo_ohlcv <- function(n = 120, seed = 123) {
  stopifnot(n >= 30)
  set.seed(seed)

  ret <- stats::rnorm(n, sd = 0.015)
  close <- cumprod(1 + ret) * 100
  open <- c(close[1], close[-n] * (1 + stats::rnorm(n - 1, sd = 0.004)))
  high <- pmax(open, close) * (1 + abs(stats::rnorm(n, sd = 0.007)))
  low <- pmin(open, close) * (1 - abs(stats::rnorm(n, sd = 0.007)))
  volume <- round(exp(stats::rnorm(n, mean = log(1e6), sd = 0.25)))

  data.frame(
    date = as.Date("2024-01-01") + seq_len(n) - 1L,
    open = open,
    high = high,
    low = low,
    close = close,
    volume = volume,
    stringsAsFactors = FALSE
  )
}

normalize_ohlcv <- function(data) {
  if (!is.data.frame(data)) {
    stop("`data` must be a data frame.", call. = FALSE)
  }
  required <- c("open", "high", "low", "close")
  missing_cols <- setdiff(required, names(data))
  if (length(missing_cols) > 0) {
    stop("Missing required columns: ", paste(missing_cols, collapse = ", "), call. = FALSE)
  }

  d <- data
  d$open <- as.numeric(d$open)
  d$high <- as.numeric(d$high)
  d$low <- as.numeric(d$low)
  d$close <- as.numeric(d$close)
  if ("volume" %in% names(d)) {
    d$volume <- as.numeric(d$volume)
  }
  if ("date" %in% names(d)) {
    d$date <- as.Date(d$date)
    d <- d[order(d$date), , drop = FALSE]
  }

  bad <- d$high < pmax(d$open, d$close) | d$low > pmin(d$open, d$close)
  if (any(bad, na.rm = TRUE)) {
    stop("Invalid OHLC relation in at least one row.", call. = FALSE)
  }

  d
}

candle_metrics <- function(d) {
  eps <- 1e-12
  body <- abs(d$close - d$open)
  rng <- pmax(d$high - d$low, eps)
  upper <- d$high - pmax(d$open, d$close)
  lower <- pmin(d$open, d$close) - d$low
  list(body = body, range = rng, upper = upper, lower = lower)
}

lag_vec <- function(x, k = 1L) {
  if (k < 0) stop("k must be >= 0", call. = FALSE)
  if (k == 0) return(x)
  c(rep(NA, k), x[seq_len(max(length(x) - k, 0))])
}

lead_vec <- function(x, k = 1L) {
  if (k < 0) stop("k must be >= 0", call. = FALSE)
  if (k == 0) return(x)
  n <- length(x)
  c(x[(k + 1):n], rep(NA, k))
}

rolling_mean <- function(x, n) {
  if (n <= 0) stop("n must be positive", call. = FALSE)
  x <- as.numeric(x)
  if (length(x) < n) {
    return(rep(NA_real_, length(x)))
  }
  as.numeric(stats::filter(x, rep(1 / n, n), sides = 1))
}

ema <- function(x, n) {
  alpha <- 2 / (n + 1)
  out <- rep(NA_real_, length(x))
  out[1] <- x[1]
  if (length(x) >= 2) {
    for (i in 2:length(x)) out[i] <- alpha * x[i] + (1 - alpha) * out[i - 1]
  }
  out
}

detect_doji <- function(d, body_ratio = 0.1) {
  m <- candle_metrics(d)
  (m$body / m$range) <= body_ratio
}

detect_hammer <- function(d, body_to_lower = 2, max_upper_to_body = 1) {
  m <- candle_metrics(d)
  (m$lower >= body_to_lower * pmax(m$body, 1e-12)) &
    (m$upper <= max_upper_to_body * pmax(m$body, 1e-12))
}

detect_inverted_hammer <- function(d, body_to_upper = 2, max_lower_to_body = 1) {
  m <- candle_metrics(d)
  (m$upper >= body_to_upper * pmax(m$body, 1e-12)) &
    (m$lower <= max_lower_to_body * pmax(m$body, 1e-12))
}

detect_shooting_star <- function(d, body_to_upper = 2, max_lower_to_body = 0.7) {
  m <- candle_metrics(d)
  bearish_bias <- d$close <= d$open
  (m$upper >= body_to_upper * pmax(m$body, 1e-12)) &
    (m$lower <= max_lower_to_body * pmax(m$body, 1e-12)) &
    bearish_bias
}

detect_bullish_engulfing <- function(d) {
  prev_open <- lag_vec(d$open)
  prev_close <- lag_vec(d$close)
  prev_bear <- prev_close < prev_open
  curr_bull <- d$close > d$open
  engulf <- (d$open <= prev_close) & (d$close >= prev_open)
  prev_bear & curr_bull & engulf
}

detect_bearish_engulfing <- function(d) {
  prev_open <- lag_vec(d$open)
  prev_close <- lag_vec(d$close)
  prev_bull <- prev_close > prev_open
  curr_bear <- d$close < d$open
  engulf <- (d$open >= prev_close) & (d$close <= prev_open)
  prev_bull & curr_bear & engulf
}

detect_bullish_harami <- function(d) {
  prev_open <- lag_vec(d$open)
  prev_close <- lag_vec(d$close)
  prev_bear <- prev_close < prev_open
  curr_bull <- d$close > d$open
  inside <- (d$open >= prev_close) & (d$close <= prev_open)
  prev_bear & curr_bull & inside
}

detect_bearish_harami <- function(d) {
  prev_open <- lag_vec(d$open)
  prev_close <- lag_vec(d$close)
  prev_bull <- prev_close > prev_open
  curr_bear <- d$close < d$open
  inside <- (d$open <= prev_close) & (d$close >= prev_open)
  prev_bull & curr_bear & inside
}

detect_piercing_line <- function(d, midpoint_ratio = 0.5) {
  prev_open <- lag_vec(d$open)
  prev_close <- lag_vec(d$close)
  prev_low <- lag_vec(d$low)
  prev_bear <- prev_close < prev_open
  curr_bull <- d$close > d$open
  midpoint <- prev_close + midpoint_ratio * (prev_open - prev_close)
  prev_bear & curr_bull &
    (d$open <= prev_low) &
    (d$close >= midpoint) &
    (d$close < prev_open)
}

detect_dark_cloud_cover <- function(d, midpoint_ratio = 0.5) {
  prev_open <- lag_vec(d$open)
  prev_close <- lag_vec(d$close)
  prev_high <- lag_vec(d$high)
  prev_bull <- prev_close > prev_open
  curr_bear <- d$close < d$open
  midpoint <- prev_open + midpoint_ratio * (prev_close - prev_open)
  prev_bull & curr_bear &
    (d$open >= prev_high) &
    (d$close <= midpoint) &
    (d$close > prev_open)
}

detect_morning_star <- function(d, star_body_ratio = 0.35) {
  m <- candle_metrics(d)
  body <- m$body
  body_l1 <- lag_vec(body, 1)
  body_l2 <- lag_vec(body, 2)
  open_l2 <- lag_vec(d$open, 2)
  close_l2 <- lag_vec(d$close, 2)

  first_bear <- close_l2 < open_l2
  star_small <- body_l1 <= star_body_ratio * body_l2
  third_bull <- d$close > d$open
  recover_mid <- d$close >= (close_l2 + 0.5 * (open_l2 - close_l2))

  first_bear & star_small & third_bull & recover_mid
}

detect_evening_star <- function(d, star_body_ratio = 0.35) {
  m <- candle_metrics(d)
  body <- m$body
  body_l1 <- lag_vec(body, 1)
  body_l2 <- lag_vec(body, 2)
  open_l2 <- lag_vec(d$open, 2)
  close_l2 <- lag_vec(d$close, 2)

  first_bull <- close_l2 > open_l2
  star_small <- body_l1 <= star_body_ratio * body_l2
  third_bear <- d$close < d$open
  fall_mid <- d$close <= (open_l2 + 0.5 * (close_l2 - open_l2))

  first_bull & star_small & third_bear & fall_mid
}

detect_three_white_soldiers <- function(d) {
  bull <- d$close > d$open
  c1 <- lag_vec(d$close, 2) > lag_vec(d$open, 2)
  c2 <- lag_vec(d$close, 1) > lag_vec(d$open, 1)
  higher_close <- (lag_vec(d$close, 1) > lag_vec(d$close, 2)) & (d$close > lag_vec(d$close, 1))
  bull & c1 & c2 & higher_close
}

detect_three_black_crows <- function(d) {
  bear <- d$close < d$open
  c1 <- lag_vec(d$close, 2) < lag_vec(d$open, 2)
  c2 <- lag_vec(d$close, 1) < lag_vec(d$open, 1)
  lower_close <- (lag_vec(d$close, 1) < lag_vec(d$close, 2)) & (d$close < lag_vec(d$close, 1))
  bear & c1 & c2 & lower_close
}

find_local_extrema <- function(x, type = c("min", "max"), span = 2) {
  type <- match.arg(type)
  n <- length(x)
  idx <- logical(n)
  if (n < (2 * span + 1)) return(idx)

  for (i in (span + 1):(n - span)) {
    neighborhood <- x[(i - span):(i + span)]
    center <- x[i]
    if (type == "min") idx[i] <- all(center <= neighborhood) else idx[i] <- all(center >= neighborhood)
  }
  idx
}

mark_last_if <- function(n, cond) {
  out <- rep(FALSE, n)
  if (isTRUE(cond) && n > 0) out[n] <- TRUE
  out
}

detect_double_bottom <- function(
    d,
    lookback = 80,
    trough_tolerance = 0.03,
    min_separation = 5,
    extrema_span = 2) {
  n <- nrow(d)
  if (n < 25) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]

  mins <- which(find_local_extrema(dd$low, type = "min", span = extrema_span))
  if (length(mins) < 2) return(rep(FALSE, n))

  pairs <- utils::combn(mins, 2)
  valid <- FALSE
  for (j in seq_len(ncol(pairs))) {
    i1 <- pairs[1, j]
    i2 <- pairs[2, j]
    if ((i2 - i1) < min_separation) next
    l1 <- dd$low[i1]
    l2 <- dd$low[i2]
    if (abs(l1 - l2) / max(l1, l2) > trough_tolerance) next
    neckline <- max(dd$high[i1:i2], na.rm = TRUE)
    if (dd$close[nrow(dd)] > neckline) {
      valid <- TRUE
      break
    }
  }
  mark_last_if(n, valid)
}

detect_double_top <- function(
    d,
    lookback = 80,
    peak_tolerance = 0.03,
    min_separation = 5,
    extrema_span = 2) {
  n <- nrow(d)
  if (n < 25) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]

  maxs <- which(find_local_extrema(dd$high, type = "max", span = extrema_span))
  if (length(maxs) < 2) return(rep(FALSE, n))

  pairs <- utils::combn(maxs, 2)
  valid <- FALSE
  for (j in seq_len(ncol(pairs))) {
    i1 <- pairs[1, j]
    i2 <- pairs[2, j]
    if ((i2 - i1) < min_separation) next
    h1 <- dd$high[i1]
    h2 <- dd$high[i2]
    if (abs(h1 - h2) / max(h1, h2) > peak_tolerance) next
    neckline <- min(dd$low[i1:i2], na.rm = TRUE)
    if (dd$close[nrow(dd)] < neckline) {
      valid <- TRUE
      break
    }
  }
  mark_last_if(n, valid)
}

detect_inverse_head_shoulders <- function(
    d,
    lookback = 120,
    shoulder_tolerance = 0.06,
    extrema_span = 2) {
  n <- nrow(d)
  if (n < 40) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]

  troughs <- which(find_local_extrema(dd$low, type = "min", span = extrema_span))
  if (length(troughs) < 3) return(rep(FALSE, n))

  valid <- FALSE
  seqs <- utils::combn(troughs, 3)
  for (j in seq_len(ncol(seqs))) {
    s1 <- seqs[1, j]
    h <- seqs[2, j]
    s2 <- seqs[3, j]
    if (!(s1 < h && h < s2)) next
    l1 <- dd$low[s1]
    lh <- dd$low[h]
    l2 <- dd$low[s2]
    shoulder_similar <- abs(l1 - l2) / max(l1, l2) <= shoulder_tolerance
    head_lower <- lh < l1 && lh < l2
    if (!(shoulder_similar && head_lower)) next
    left_peak <- max(dd$high[s1:h], na.rm = TRUE)
    right_peak <- max(dd$high[h:s2], na.rm = TRUE)
    neckline <- max(left_peak, right_peak)
    if (dd$close[nrow(dd)] > neckline) {
      valid <- TRUE
      break
    }
  }
  mark_last_if(n, valid)
}

detect_ascending_triangle <- function(
    d,
    lookback = 90,
    resistance_tolerance = 0.02,
    extrema_span = 2,
    min_touch = 2) {
  n <- nrow(d)
  if (n < 40) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]

  highs_idx <- which(find_local_extrema(dd$high, type = "max", span = extrema_span))
  lows_idx <- which(find_local_extrema(dd$low, type = "min", span = extrema_span))
  if (length(highs_idx) < min_touch || length(lows_idx) < min_touch) return(rep(FALSE, n))

  highs <- dd$high[highs_idx]
  resistance <- stats::median(highs, na.rm = TRUE)
  flat_highs <- abs(highs - resistance) / resistance <= resistance_tolerance
  if (sum(flat_highs, na.rm = TRUE) < min_touch) return(rep(FALSE, n))

  rising_lows <- dd$low[lows_idx]
  x <- seq_along(rising_lows)
  slope <- stats::coef(stats::lm(rising_lows ~ x))[2]
  breakout <- dd$close[nrow(dd)] > resistance

  mark_last_if(n, slope > 0 && breakout)
}

detect_golden_pit <- function(
    d,
    ma_window = 20,
    breakdown_pct = 0.03,
    bottom_window = 8,
    vol_shrink_ratio = 0.85,
    vol_expand_ratio = 1.30,
    rebound_pct = 0.06,
    use_macd = TRUE) {
  n <- nrow(d)
  if (!("volume" %in% names(d))) {
    stop("`golden_pit` requires a `volume` column.", call. = FALSE)
  }
  if (n < max(60, ma_window + bottom_window + 5)) return(rep(FALSE, n))

  ma <- as.numeric(rolling_mean(d$close, ma_window))
  below_ma <- d$close < ma * (1 - breakdown_pct)
  has_breakdown <- any(below_ma[1:(n - bottom_window)], na.rm = TRUE)
  if (!has_breakdown) return(rep(FALSE, n))

  recent_idx <- (n - bottom_window + 1):n
  bottom_idx <- recent_idx[which.min(d$close[recent_idx])]
  bottom_close <- d$close[bottom_idx]
  latest_close <- d$close[n]

  pre_start <- max(1, bottom_idx - bottom_window)
  pre_end <- max(pre_start, bottom_idx - 1)
  prior_vol <- mean(d$volume[pre_start:pre_end], na.rm = TRUE)
  bottom_vol <- mean(d$volume[bottom_idx:min(n, bottom_idx + 2)], na.rm = TRUE)
  vol_shrunk <- is.finite(prior_vol) && is.finite(bottom_vol) && bottom_vol <= prior_vol * vol_shrink_ratio

  vol_recent <- mean(d$volume[(n - min(10, n) + 1):n], na.rm = TRUE)
  vol_expand <- d$volume[n] >= vol_recent * vol_expand_ratio

  rebound <- (latest_close / bottom_close - 1) >= rebound_pct
  recover_ma <- !is.na(ma[n]) && latest_close > ma[n]

  macd_ok <- TRUE
  if (isTRUE(use_macd)) {
    macd <- ema(d$close, 12) - ema(d$close, 26)
    signal <- ema(macd, 9)
    macd_ok <- macd[n] > signal[n] && macd[n] > lag_vec(macd, 1)[n]
  }

  mark_last_if(n, vol_shrunk && vol_expand && rebound && recover_ma && macd_ok)
}

is_supported_pattern <- function(pattern) {
  !is.na(resolve_pattern_id(pattern))
}

resolve_pattern_id <- function(pattern) {
  if (length(pattern) != 1 || is.na(pattern)) {
    return(NA_character_)
  }
  key <- trimws(pattern)

  catalog <- pattern_catalog()
  alias_map <- c(
    stats::setNames(catalog$pattern_id, catalog$pattern_id),
    stats::setNames(catalog$pattern_id, catalog$pattern_cn),
    pattern_aliases()
  )
  out <- unname(alias_map[key])
  if (length(out) == 0 || is.na(out)) {
    return(NA_character_)
  }
  out
}

.kline_cache <- new.env(parent = emptyenv())

pattern_aliases <- function() {
  if (exists("alias", envir = .kline_cache, inherits = FALSE)) {
    return(get("alias", envir = .kline_cache, inherits = FALSE))
  }

  path <- system.file("extdata", "pattern_alias.csv", package = "klineR")
  if (!nzchar(path)) {
    path <- file.path("inst", "extdata", "pattern_alias.csv")
  }
  if (!file.exists(path)) {
    return(character())
  }

  txt <- readLines(path, warn = FALSE, encoding = "UTF-8")
  aliases <- utils::read.csv(
    text = enc2utf8(paste(txt, collapse = "\n")),
    stringsAsFactors = FALSE
  )
  expected_cols <- c("alias", "pattern_id")
  if (!identical(names(aliases), expected_cols)) {
    stop("Invalid alias structure in pattern_alias.csv.", call. = FALSE)
  }
  if (anyDuplicated(aliases$alias)) {
    stop("Duplicate alias values found in pattern_alias.csv.", call. = FALSE)
  }
  valid_ids <- pattern_catalog()$pattern_id
  if (any(!aliases$pattern_id %in% valid_ids)) {
    stop("Unknown pattern_id found in pattern_alias.csv.", call. = FALSE)
  }

  out <- stats::setNames(aliases$pattern_id, aliases$alias)
  assign("alias", out, envir = .kline_cache)
  out
}

get_pattern_detector <- function(pattern_id) {
  f <- switch(
    pattern_id,
    hammer = detect_hammer,
    hanging_man = detect_hanging_man,
    inverted_hammer = detect_inverted_hammer,
    shooting_star = detect_shooting_star,
    long_lower_shadow = detect_long_lower_shadow,
    long_upper_shadow = detect_long_upper_shadow,
    bullish_marubozu = detect_bullish_marubozu,
    bearish_marubozu = detect_bearish_marubozu,
    bullish_shaven_bottom = detect_bullish_shaven_bottom,
    bearish_shaven_bottom = detect_bearish_shaven_bottom,
    doji = detect_doji,
    t_doji = detect_t_doji,
    bullish_engulfing = detect_bullish_engulfing,
    piercing_line = detect_piercing_line,
    rising_sun = detect_rising_sun,
    bullish_counterattack = detect_bullish_counterattack,
    tweezer_bottom = detect_tweezer_bottom,
    bullish_harami = detect_low_bullish_harami,
    bearish_engulfing = detect_bearish_engulfing,
    dark_cloud_cover = detect_dark_cloud_cover,
    downpour = detect_downpour,
    bearish_counterattack = detect_bearish_counterattack,
    tweezer_top = detect_tweezer_top,
    bearish_harami = detect_high_bearish_harami,
    bearish_outside = detect_bearish_outside,
    morning_star = detect_morning_star,
    three_white_soldiers = detect_three_white_soldiers,
    rising_three_methods = detect_rising_three_methods,
    bullish_sandwich = detect_bullish_sandwich,
    low_three_rising = detect_low_three_rising,
    tower_bottom = detect_tower_bottom,
    evening_star = detect_evening_star,
    three_black_crows = detect_three_black_crows,
    falling_three_methods = detect_falling_three_methods,
    bearish_sandwich = detect_bearish_sandwich,
    high_three_falling = detect_high_three_falling,
    tower_top = detect_tower_top,
    inverse_head_shoulders = detect_inverse_head_shoulders,
    double_bottom = detect_double_bottom,
    triple_bottom = detect_triple_bottom,
    rounded_bottom = detect_rounded_bottom,
    v_bottom = detect_v_bottom,
    low_five_rise = detect_low_five_rise,
    low_consolidation = detect_low_consolidation,
    head_shoulders_top = detect_head_shoulders_top,
    double_top = detect_double_top,
    triple_top = detect_triple_top,
    rounded_top = detect_rounded_top,
    v_top = detect_v_top,
    high_consolidation = detect_high_consolidation,
    ascending_triangle = detect_ascending_triangle,
    descending_triangle = detect_descending_triangle,
    sym_triangle = detect_symmetric_triangle,
    bull_flag = detect_bull_flag,
    bear_flag = detect_bear_flag,
    rising_wedge = detect_rising_wedge,
    falling_wedge = detect_falling_wedge,
    rectangle = detect_rectangle,
    broadening_triangle = detect_broadening_triangle,
    diamond = detect_diamond,
    ascending_channel = detect_ascending_channel,
    descending_channel = detect_descending_channel,
    breakaway_gap = detect_breakaway_gap,
    continuation_gap = detect_continuation_gap,
    exhaustion_gap = detect_exhaustion_gap,
    island_reversal = detect_island_reversal,
    old_duck_head = detect_old_duck_head,
    golden_pit = detect_golden_pit,
    NULL
  )

  if (is.null(f)) {
    stop(
      "Unsupported pattern `", pattern_id,
      "`. Use `available_patterns()` or `pattern_catalog()`.",
      call. = FALSE
    )
  }
  f
}

trend_strength <- function(close, n = 5L) {
  close / lag_vec(close, n) - 1
}

near_equal <- function(x, y, tol = 0.0025) {
  abs(x - y) / pmax(abs(y), 1e-12) <= tol
}

detect_hanging_man <- function(d, trend_n = 5) {
  detect_hammer(d) & (trend_strength(d$close, trend_n) > 0.03)
}

detect_long_lower_shadow <- function(d, ratio = 2) {
  m <- candle_metrics(d)
  m$lower >= ratio * pmax(m$body, 1e-12)
}

detect_long_upper_shadow <- function(d, ratio = 2) {
  m <- candle_metrics(d)
  m$upper >= ratio * pmax(m$body, 1e-12)
}

detect_bullish_marubozu <- function(d, tol = 0.001) {
  m <- candle_metrics(d)
  (d$close > d$open) &
    (m$upper / pmax(d$close, 1e-12) <= tol) &
    (m$lower / pmax(d$open, 1e-12) <= tol)
}

detect_bearish_marubozu <- function(d, tol = 0.001) {
  m <- candle_metrics(d)
  (d$close < d$open) &
    (m$upper / pmax(d$open, 1e-12) <= tol) &
    (m$lower / pmax(d$close, 1e-12) <= tol)
}

detect_bullish_shaven_bottom <- function(d, tol = 0.001) {
  (d$close > d$open) & near_equal(pmin(d$open, d$close), d$low, tol = tol)
}

detect_bearish_shaven_bottom <- function(d, tol = 0.001) {
  (d$close < d$open) & near_equal(pmin(d$open, d$close), d$low, tol = tol)
}

detect_t_doji <- function(d, tol = 0.001) {
  doji <- detect_doji(d, body_ratio = 0.06)
  doji & (near_equal(d$close, d$low, tol = tol) | near_equal(d$close, d$high, tol = tol))
}

detect_rising_sun <- function(d) {
  prev_bear <- lag_vec(d$close) < lag_vec(d$open)
  curr_bull <- d$close > d$open
  gap_up <- d$open > lag_vec(d$close)
  close_above_prev_open <- d$close > lag_vec(d$open)
  prev_bear & curr_bull & gap_up & close_above_prev_open
}

detect_bullish_counterattack <- function(d, tol = 0.004) {
  prev_bear <- lag_vec(d$close) < lag_vec(d$open)
  curr_bull <- d$close > d$open
  close_near <- near_equal(d$close, lag_vec(d$close), tol = tol)
  prev_bear & curr_bull & close_near
}

detect_tweezer_bottom <- function(d, tol = 0.005) {
  prev_bear <- lag_vec(d$close) < lag_vec(d$open)
  curr_bull <- d$close > d$open
  near_equal(d$low, lag_vec(d$low), tol = tol) & prev_bear & curr_bull
}

detect_low_bullish_harami <- function(d) {
  detect_bullish_harami(d) & (d$close < rolling_mean(d$close, 20))
}

detect_downpour <- function(d) {
  prev_bull <- lag_vec(d$close) > lag_vec(d$open)
  curr_bear <- d$close < d$open
  gap_up <- d$open > lag_vec(d$high)
  deep_fall <- d$close < lag_vec(d$open)
  prev_bull & curr_bear & gap_up & deep_fall
}

detect_bearish_counterattack <- function(d, tol = 0.004) {
  prev_bull <- lag_vec(d$close) > lag_vec(d$open)
  curr_bear <- d$close < d$open
  close_near <- near_equal(d$close, lag_vec(d$close), tol = tol)
  prev_bull & curr_bear & close_near
}

detect_tweezer_top <- function(d, tol = 0.005) {
  prev_bull <- lag_vec(d$close) > lag_vec(d$open)
  curr_bear <- d$close < d$open
  near_equal(d$high, lag_vec(d$high), tol = tol) & prev_bull & curr_bear
}

detect_high_bearish_harami <- function(d) {
  detect_bearish_harami(d) & (d$close > rolling_mean(d$close, 20))
}

detect_bearish_outside <- function(d) {
  prev_bull <- lag_vec(d$close) > lag_vec(d$open)
  curr_bear <- d$close < d$open
  outside <- d$high > lag_vec(d$high) & d$low < lag_vec(d$low)
  prev_bull & curr_bear & outside
}

detect_rising_three_methods <- function(d) {
  first_bull <- lag_vec(d$close, 3) > lag_vec(d$open, 3)
  middle_adjust <- lag_vec(d$close, 2) < lag_vec(d$open, 2) &
    lag_vec(d$close, 1) < lag_vec(d$open, 1)
  in_range <- lag_vec(d$high, 2) < lag_vec(d$high, 3) &
    lag_vec(d$high, 1) < lag_vec(d$high, 3)
  last_break <- d$close > lag_vec(d$close, 3) & d$close > d$open
  first_bull & middle_adjust & in_range & last_break
}

detect_falling_three_methods <- function(d) {
  first_bear <- lag_vec(d$close, 3) < lag_vec(d$open, 3)
  middle_adjust <- lag_vec(d$close, 2) > lag_vec(d$open, 2) &
    lag_vec(d$close, 1) > lag_vec(d$open, 1)
  in_range <- lag_vec(d$low, 2) > lag_vec(d$low, 3) &
    lag_vec(d$low, 1) > lag_vec(d$low, 3)
  last_break <- d$close < lag_vec(d$close, 3) & d$close < d$open
  first_bear & middle_adjust & in_range & last_break
}

detect_bullish_sandwich <- function(d) {
  lag_vec(d$close, 2) > lag_vec(d$open, 2) &
    lag_vec(d$close, 1) < lag_vec(d$open, 1) &
    d$close > d$open &
    d$close > lag_vec(d$close, 2)
}

detect_bearish_sandwich <- function(d) {
  lag_vec(d$close, 2) < lag_vec(d$open, 2) &
    lag_vec(d$close, 1) > lag_vec(d$open, 1) &
    d$close < d$open &
    d$close < lag_vec(d$close, 2)
}

detect_low_three_rising <- function(d) {
  three_up <- d$close > d$open &
    lag_vec(d$close, 1) > lag_vec(d$open, 1) &
    lag_vec(d$close, 2) > lag_vec(d$open, 2)
  low_zone <- d$close < rolling_mean(d$close, 60)
  three_up & low_zone
}

detect_high_three_falling <- function(d) {
  three_down <- d$close < d$open &
    lag_vec(d$close, 1) < lag_vec(d$open, 1) &
    lag_vec(d$close, 2) < lag_vec(d$open, 2)
  high_zone <- d$close > rolling_mean(d$close, 60)
  three_down & high_zone
}

detect_tower_bottom <- function(d) {
  first_drop <- lag_vec(d$close, 3) < lag_vec(d$open, 3)
  middle_small <- (abs(lag_vec(d$close, 2) - lag_vec(d$open, 2)) / pmax(lag_vec(d$open, 2), 1e-12) < 0.02) &
    (abs(lag_vec(d$close, 1) - lag_vec(d$open, 1)) / pmax(lag_vec(d$open, 1), 1e-12) < 0.02)
  final_rise <- d$close > d$open & (d$close / lag_vec(d$close, 1) > 1.02)
  first_drop & middle_small & final_rise
}

detect_tower_top <- function(d) {
  first_rise <- lag_vec(d$close, 3) > lag_vec(d$open, 3)
  middle_small <- (abs(lag_vec(d$close, 2) - lag_vec(d$open, 2)) / pmax(lag_vec(d$open, 2), 1e-12) < 0.02) &
    (abs(lag_vec(d$close, 1) - lag_vec(d$open, 1)) / pmax(lag_vec(d$open, 1), 1e-12) < 0.02)
  final_fall <- d$close < d$open & (d$close / lag_vec(d$close, 1) < 0.98)
  first_rise & middle_small & final_fall
}

detect_triple_bottom <- function(d, lookback = 120, trough_tolerance = 0.035, extrema_span = 2) {
  n <- nrow(d)
  if (n < 60) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]
  mins <- which(find_local_extrema(dd$low, "min", extrema_span))
  if (length(mins) < 3) return(rep(FALSE, n))
  combos <- utils::combn(mins, 3)
  valid <- FALSE
  for (j in seq_len(ncol(combos))) {
    ids <- combos[, j]
    lows <- dd$low[ids]
    if (max(lows) <= 0) next
    if ((max(lows) - min(lows)) / max(lows) > trough_tolerance) next
    neckline <- max(dd$high[min(ids):max(ids)], na.rm = TRUE)
    if (dd$close[nrow(dd)] > neckline) {
      valid <- TRUE
      break
    }
  }
  mark_last_if(n, valid)
}

detect_triple_top <- function(d, lookback = 120, peak_tolerance = 0.035, extrema_span = 2) {
  n <- nrow(d)
  if (n < 60) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]
  maxs <- which(find_local_extrema(dd$high, "max", extrema_span))
  if (length(maxs) < 3) return(rep(FALSE, n))
  combos <- utils::combn(maxs, 3)
  valid <- FALSE
  for (j in seq_len(ncol(combos))) {
    ids <- combos[, j]
    highs <- dd$high[ids]
    if ((max(highs) - min(highs)) / max(highs) > peak_tolerance) next
    neckline <- min(dd$low[min(ids):max(ids)], na.rm = TRUE)
    if (dd$close[nrow(dd)] < neckline) {
      valid <- TRUE
      break
    }
  }
  mark_last_if(n, valid)
}

detect_rounded_bottom <- function(d, lookback = 60) {
  n <- nrow(d)
  if (n < lookback + 5) return(rep(FALSE, n))
  x <- seq_len(lookback)
  y <- d$close[(n - lookback + 1):n]
  fit <- stats::lm(y ~ x + I(x^2))
  co <- stats::coef(fit)
  if (any(!is.finite(co))) return(rep(FALSE, n))
  tail_n <- min(10L, lookback)
  tail_start <- lookback - tail_n + 1L
  tail_mean <- mean(y[tail_start:lookback], na.rm = TRUE)
  cond <- co[3] > 0 && co[2] < 0 && y[length(y)] > tail_mean
  mark_last_if(n, cond)
}

detect_rounded_top <- function(d, lookback = 60) {
  n <- nrow(d)
  if (n < lookback + 5) return(rep(FALSE, n))
  x <- seq_len(lookback)
  y <- d$close[(n - lookback + 1):n]
  fit <- stats::lm(y ~ x + I(x^2))
  co <- stats::coef(fit)
  if (any(!is.finite(co))) return(rep(FALSE, n))
  tail_n <- min(10L, lookback)
  tail_start <- lookback - tail_n + 1L
  tail_mean <- mean(y[tail_start:lookback], na.rm = TRUE)
  cond <- co[3] < 0 && co[2] > 0 && y[length(y)] < tail_mean
  mark_last_if(n, cond)
}

detect_v_bottom <- function(d, drop_pct = 0.05, rebound_pct = 0.05, window = 5) {
  n <- nrow(d)
  if (n < (2 * window + 1)) return(rep(FALSE, n))
  left <- d$close[n - 2 * window]
  mid <- d$close[n - window]
  right <- d$close[n]
  cond <- (mid / left - 1) <= -drop_pct && (right / mid - 1) >= rebound_pct
  mark_last_if(n, cond)
}

detect_v_top <- function(d, rise_pct = 0.05, fall_pct = 0.05, window = 5) {
  n <- nrow(d)
  if (n < (2 * window + 1)) return(rep(FALSE, n))
  left <- d$close[n - 2 * window]
  mid <- d$close[n - window]
  right <- d$close[n]
  cond <- (mid / left - 1) >= rise_pct && (right / mid - 1) <= -fall_pct
  mark_last_if(n, cond)
}

detect_low_five_rise <- function(d) {
  n <- nrow(d)
  if (n < 5) return(rep(FALSE, n))
  up5 <- all(utils::tail(d$close, 5) > utils::tail(d$open, 5))
  low_zone <- d$close[n] < as.numeric(rolling_mean(d$close, 60))[n]
  mark_last_if(n, up5 && isTRUE(low_zone))
}

detect_low_consolidation <- function(d, width = 8, tol = 0.03) {
  n <- nrow(d)
  if (n < width + 1) return(rep(FALSE, n))
  seg <- d[(n - width):(n - 1), ]
  range_pct <- (max(seg$high) - min(seg$low)) / max(seg$high)
  breakout <- d$close[n] > max(seg$high)
  low_zone <- d$close[n] < as.numeric(rolling_mean(d$close, 60))[n]
  mark_last_if(n, range_pct <= tol && breakout && isTRUE(low_zone))
}

detect_high_consolidation <- function(d, width = 8, tol = 0.03) {
  n <- nrow(d)
  if (n < width + 1) return(rep(FALSE, n))
  seg <- d[(n - width):(n - 1), ]
  range_pct <- (max(seg$high) - min(seg$low)) / max(seg$high)
  breakdown <- d$close[n] < min(seg$low)
  high_zone <- d$close[n] > as.numeric(rolling_mean(d$close, 60))[n]
  mark_last_if(n, range_pct <= tol && breakdown && isTRUE(high_zone))
}

detect_head_shoulders_top <- function(d, lookback = 120, shoulder_tolerance = 0.06, extrema_span = 2) {
  n <- nrow(d)
  if (n < 40) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]
  peaks <- which(find_local_extrema(dd$high, type = "max", span = extrema_span))
  if (length(peaks) < 3) return(rep(FALSE, n))
  valid <- FALSE
  seqs <- utils::combn(peaks, 3)
  for (j in seq_len(ncol(seqs))) {
    s1 <- seqs[1, j]
    h <- seqs[2, j]
    s2 <- seqs[3, j]
    p1 <- dd$high[s1]
    ph <- dd$high[h]
    p2 <- dd$high[s2]
    shoulder_similar <- abs(p1 - p2) / max(p1, p2) <= shoulder_tolerance
    head_higher <- ph > p1 && ph > p2
    if (!(shoulder_similar && head_higher)) next
    left_trough <- min(dd$low[s1:h], na.rm = TRUE)
    right_trough <- min(dd$low[h:s2], na.rm = TRUE)
    neckline <- min(left_trough, right_trough)
    if (dd$close[nrow(dd)] < neckline) {
      valid <- TRUE
      break
    }
  }
  mark_last_if(n, valid)
}

detect_descending_triangle <- function(d, lookback = 90, support_tolerance = 0.02, extrema_span = 2, min_touch = 2) {
  n <- nrow(d)
  if (n < 40) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]

  highs_idx <- which(find_local_extrema(dd$high, type = "max", span = extrema_span))
  lows_idx <- which(find_local_extrema(dd$low, type = "min", span = extrema_span))
  if (length(highs_idx) < min_touch || length(lows_idx) < min_touch) return(rep(FALSE, n))

  lows <- dd$low[lows_idx]
  support <- stats::median(lows, na.rm = TRUE)
  flat_lows <- abs(lows - support) / support <= support_tolerance
  if (sum(flat_lows, na.rm = TRUE) < min_touch) return(rep(FALSE, n))

  falling_highs <- dd$high[highs_idx]
  x <- seq_along(falling_highs)
  slope <- stats::coef(stats::lm(falling_highs ~ x))[2]
  breakout <- dd$close[nrow(dd)] < support

  mark_last_if(n, slope < 0 && breakout)
}

detect_symmetric_triangle <- function(d, lookback = 80, extrema_span = 2) {
  n <- nrow(d)
  if (n < 40) return(rep(FALSE, n))
  idx0 <- max(1, n - lookback + 1)
  dd <- d[idx0:n, , drop = FALSE]
  highs_idx <- which(find_local_extrema(dd$high, "max", extrema_span))
  lows_idx <- which(find_local_extrema(dd$low, "min", extrema_span))
  if (length(highs_idx) < 3 || length(lows_idx) < 3) return(rep(FALSE, n))
  hs <- dd$high[highs_idx]
  ls <- dd$low[lows_idx]
  hs_slope <- stats::coef(stats::lm(hs ~ seq_along(hs)))[2]
  ls_slope <- stats::coef(stats::lm(ls ~ seq_along(ls)))[2]
  narrowing <- (max(hs, na.rm = TRUE) - min(ls, na.rm = TRUE)) >
    (utils::tail(hs, 1) - utils::tail(ls, 1))
  breakout <- dd$close[nrow(dd)] > max(utils::tail(hs, 3)) ||
    dd$close[nrow(dd)] < min(utils::tail(ls, 3))
  mark_last_if(n, hs_slope < 0 && ls_slope > 0 && narrowing && breakout)
}

detect_bull_flag <- function(d, pole_window = 6, flag_window = 6) {
  n <- nrow(d)
  if (n < pole_window + flag_window + 3) return(rep(FALSE, n))
  pole_start <- n - pole_window - flag_window
  pole_end <- n - flag_window
  pole_ret <- d$close[pole_end] / d$close[pole_start] - 1
  flag_seg <- d[(pole_end + 1):(n - 1), , drop = FALSE]
  pullback <- (max(flag_seg$high) - min(flag_seg$low)) / max(flag_seg$high) < 0.08
  breakout <- d$close[n] > max(flag_seg$high)
  mark_last_if(n, pole_ret > 0.08 && pullback && breakout)
}

detect_bear_flag <- function(d, pole_window = 6, flag_window = 6) {
  n <- nrow(d)
  if (n < pole_window + flag_window + 3) return(rep(FALSE, n))
  pole_start <- n - pole_window - flag_window
  pole_end <- n - flag_window
  pole_ret <- d$close[pole_end] / d$close[pole_start] - 1
  flag_seg <- d[(pole_end + 1):(n - 1), , drop = FALSE]
  pullback <- (max(flag_seg$high) - min(flag_seg$low)) / max(flag_seg$high) < 0.08
  breakdown <- d$close[n] < min(flag_seg$low)
  mark_last_if(n, pole_ret < -0.08 && pullback && breakdown)
}

detect_rising_wedge <- function(d, lookback = 50) {
  n <- nrow(d)
  if (n < lookback) return(rep(FALSE, n))
  seg <- d[(n - lookback + 1):n, ]
  x <- seq_len(nrow(seg))
  h_fit <- stats::coef(stats::lm(seg$high ~ x))
  l_fit <- stats::coef(stats::lm(seg$low ~ x))
  spread_start <- (h_fit[1] + h_fit[2]) - (l_fit[1] + l_fit[2])
  spread_end <- (h_fit[1] + h_fit[2] * lookback) - (l_fit[1] + l_fit[2] * lookback)
  mark_last_if(n, h_fit[2] > 0 && l_fit[2] > 0 && spread_end < spread_start)
}

detect_falling_wedge <- function(d, lookback = 50) {
  n <- nrow(d)
  if (n < lookback) return(rep(FALSE, n))
  seg <- d[(n - lookback + 1):n, ]
  x <- seq_len(nrow(seg))
  h_fit <- stats::coef(stats::lm(seg$high ~ x))
  l_fit <- stats::coef(stats::lm(seg$low ~ x))
  spread_start <- (h_fit[1] + h_fit[2]) - (l_fit[1] + l_fit[2])
  spread_end <- (h_fit[1] + h_fit[2] * lookback) - (l_fit[1] + l_fit[2] * lookback)
  mark_last_if(n, h_fit[2] < 0 && l_fit[2] < 0 && spread_end < spread_start)
}

detect_rectangle <- function(d, lookback = 30, tol = 0.03) {
  n <- nrow(d)
  if (n < lookback + 1) return(rep(FALSE, n))
  seg <- d[(n - lookback):(n - 1), ]
  range_pct <- (max(seg$high) - min(seg$low)) / max(seg$high)
  breakout <- d$close[n] > max(seg$high) || d$close[n] < min(seg$low)
  mark_last_if(n, range_pct <= tol && breakout)
}

detect_broadening_triangle <- function(d, lookback = 40) {
  n <- nrow(d)
  if (n < lookback) return(rep(FALSE, n))
  seg <- d[(n - lookback + 1):n, ]
  half <- floor(nrow(seg) / 2)
  early <- seg[1:half, ]
  late <- seg[(half + 1):nrow(seg), ]
  early_spread <- max(early$high) - min(early$low)
  late_spread <- max(late$high) - min(late$low)
  mark_last_if(n, late_spread > early_spread * 1.15)
}

detect_diamond <- function(d, lookback = 50) {
  n <- nrow(d)
  if (n < lookback) return(rep(FALSE, n))
  seg <- d[(n - lookback + 1):n, ]
  q <- floor(nrow(seg) / 4)
  s1 <- seg[1:q, ]
  s2 <- seg[(q + 1):(2 * q), ]
  s3 <- seg[(2 * q + 1):(3 * q), ]
  s4 <- seg[(3 * q + 1):nrow(seg), ]
  sp1 <- max(s1$high) - min(s1$low)
  sp2 <- max(s2$high) - min(s2$low)
  sp3 <- max(s3$high) - min(s3$low)
  sp4 <- max(s4$high) - min(s4$low)
  mark_last_if(n, sp2 > sp1 && sp3 > sp2 && sp4 < sp3)
}

detect_ascending_channel <- function(d, lookback = 50) {
  n <- nrow(d)
  if (n < lookback) return(rep(FALSE, n))
  seg <- d[(n - lookback + 1):n, ]
  x <- seq_len(nrow(seg))
  fit <- stats::lm(seg$close ~ x)
  slope <- stats::coef(fit)[2]
  r2 <- summary(fit)$r.squared
  mark_last_if(n, slope > 0 && r2 > 0.7)
}

detect_descending_channel <- function(d, lookback = 50) {
  n <- nrow(d)
  if (n < lookback) return(rep(FALSE, n))
  seg <- d[(n - lookback + 1):n, ]
  x <- seq_len(nrow(seg))
  fit <- stats::lm(seg$close ~ x)
  slope <- stats::coef(fit)[2]
  r2 <- summary(fit)$r.squared
  mark_last_if(n, slope < 0 && r2 > 0.7)
}

detect_breakaway_gap <- function(d) {
  gap_up <- d$low > lag_vec(d$high)
  gap_down <- d$high < lag_vec(d$low)
  breakout_up <- d$close > lag_vec(cummax(d$high))
  breakout_down <- d$close < lag_vec(cummin(d$low))
  (gap_up & breakout_up) | (gap_down & breakout_down)
}

detect_continuation_gap <- function(d, trend_n = 6) {
  trend <- abs(trend_strength(d$close, trend_n)) > 0.06
  gap <- (d$low > lag_vec(d$high)) | (d$high < lag_vec(d$low))
  trend & gap
}

detect_exhaustion_gap <- function(d, trend_n = 10, vol_mult = 1.8) {
  trend <- abs(trend_strength(d$close, trend_n)) > 0.12
  gap <- (d$low > lag_vec(d$high)) | (d$high < lag_vec(d$low))
  has_vol <- if ("volume" %in% names(d)) {
    d$volume > lag_vec(as.numeric(rolling_mean(d$volume, 5))) * vol_mult
  } else {
    rep(TRUE, nrow(d))
  }
  reverse <- (d$close < d$open & trend_strength(d$close, 3) > 0) |
    (d$close > d$open & trend_strength(d$close, 3) < 0)
  trend & gap & has_vol & reverse
}

detect_island_reversal <- function(d) {
  left_gap_up <- lag_vec(d$low, 2) > lag_vec(d$high, 3)
  right_gap_down <- d$high < lag_vec(d$low, 1)
  left_gap_down <- lag_vec(d$high, 2) < lag_vec(d$low, 3)
  right_gap_up <- d$low > lag_vec(d$high, 1)
  (left_gap_up & right_gap_down) | (left_gap_down & right_gap_up)
}

detect_old_duck_head <- function(d) {
  ma5 <- as.numeric(rolling_mean(d$close, 5))
  ma10 <- as.numeric(rolling_mean(d$close, 10))
  ma60 <- as.numeric(rolling_mean(d$close, 60))
  neck <- ma5 > ma10 & ma10 > ma60
  duck_head <- lag_vec(ma5 > ma10 & ma5 < lag_vec(ma5), 1)
  duck_beak <- ma5 > ma10 & ma5 > lag_vec(ma5)
  neck & duck_head & duck_beak
}

#' Simulate Multiple Symbol OHLCV Series
#'
#' Generates synthetic OHLCV data for several symbols and injects representative
#' chart structures so pattern-screening workflows can be tested end-to-end.
#'
#' @param symbols Character vector of symbol names.
#' @param n Number of rows per symbol.
#' @param seed Random seed.
#'
#' @return A named list of OHLCV data frames.
#'
#' @examples
#' sim <- simulate_symbols(c("AAA", "BBB"), n = 180, seed = 7)
#' names(sim)
#' @export
simulate_symbols <- function(symbols = c("AAA", "BBB", "CCC"), n = 220, seed = 123) {
  stopifnot(length(symbols) >= 1, n >= 120)
  out <- vector("list", length(symbols))
  names(out) <- symbols

  for (i in seq_along(symbols)) {
    d <- demo_ohlcv(n = n, seed = seed + i)
    if (i %% 3 == 1) d <- inject_double_bottom_path(d)
    if (i %% 3 == 2) d <- inject_golden_pit_path(d)
    if (i %% 3 == 0) d <- inject_triangle_path(d)
    out[[i]] <- d
  }
  out
}

inject_double_bottom_path <- function(d) {
  n <- nrow(d)
  idx <- (n - 40):n
  base <- d$close[n - 40]
  path <- c(
    seq(base, base * 0.86, length.out = 10),
    seq(base * 0.86, base * 0.94, length.out = 8),
    seq(base * 0.94, base * 0.87, length.out = 8),
    seq(base * 0.87, base * 1.03, length.out = 15)
  )
  path <- path[1:length(idx)]
  d$close[idx] <- path
  d$open[idx] <- c(path[1], utils::head(path, -1)) * (1 + stats::rnorm(length(idx), sd = 0.003))
  d$high[idx] <- pmax(d$open[idx], d$close[idx]) * (1 + abs(stats::rnorm(length(idx), sd = 0.004)))
  d$low[idx] <- pmin(d$open[idx], d$close[idx]) * (1 - abs(stats::rnorm(length(idx), sd = 0.004)))
  d$volume[idx] <- round(d$volume[idx] * seq(0.95, 1.25, length.out = length(idx)))
  d
}

inject_golden_pit_path <- function(d) {
  n <- nrow(d)
  idx <- (n - 45):n
  pre <- d$close[n - 45]
  path <- c(
    seq(pre, pre * 0.9, length.out = 10),
    seq(pre * 0.9, pre * 0.8, length.out = 8),
    seq(pre * 0.8, pre * 0.82, length.out = 8),
    seq(pre * 0.82, pre * 0.96, length.out = 20)
  )
  path <- path[1:length(idx)]
  d$close[idx] <- path
  d$open[idx] <- c(path[1], utils::head(path, -1)) * (1 + stats::rnorm(length(idx), sd = 0.004))
  d$high[idx] <- pmax(d$open[idx], d$close[idx]) * (1 + abs(stats::rnorm(length(idx), sd = 0.004)))
  d$low[idx] <- pmin(d$open[idx], d$close[idx]) * (1 - abs(stats::rnorm(length(idx), sd = 0.004)))
  d$volume[idx[1:20]] <- round(d$volume[idx[1:20]] * 0.75)
  d$volume[idx[21:length(idx)]] <- round(d$volume[idx[21:length(idx)]] * 1.45)
  d
}

inject_triangle_path <- function(d) {
  n <- nrow(d)
  idx <- (n - 40):n
  resistance <- max(d$close[(n - 70):(n - 50)])
  lows <- seq(resistance * 0.84, resistance * 0.95, length.out = length(idx))
  osc <- sin(seq(0, 8 * pi, length.out = length(idx))) * resistance * 0.015
  close <- pmin(resistance * 0.995, lows + abs(osc))
  close[length(close)] <- resistance * 1.03
  d$close[idx] <- close
  d$open[idx] <- c(close[1], utils::head(close, -1)) * (1 + stats::rnorm(length(idx), sd = 0.003))
  d$high[idx] <- pmax(d$open[idx], d$close[idx]) * (1 + abs(stats::rnorm(length(idx), sd = 0.003)))
  d$low[idx] <- pmin(d$open[idx], d$close[idx]) * (1 - abs(stats::rnorm(length(idx), sd = 0.003)))
  d$volume[idx] <- round(d$volume[idx] * seq(0.9, 1.2, length.out = length(idx)))
  d
}

#' Plot K-line with Pattern Annotations
#'
#' Draws candlesticks with optional pattern markers for visual verification.
#'
#' @param data OHLCV data frame.
#' @param pattern Optional pattern identifier or Chinese name.
#' @param detections Optional logical vector from [detect_pattern()]. If
#'   `NULL`, detections are computed from `pattern`.
#' @param main Plot title.
#' @param max_labels Maximum number of labels to draw.
#' @param file Optional PNG file path. If supplied, the plot is saved to disk.
#'
#' @return Invisibly returns detection indices.
#'
#' @examples
#' d <- demo_ohlcv(140, seed = 1)
#' plot_kline_patterns(d, pattern = "doji", max_labels = 5)
#' @export
plot_kline_patterns <- function(
    data,
    pattern = NULL,
    detections = NULL,
    main = NULL,
    max_labels = 10,
    file = NULL) {
  d <- normalize_ohlcv(data)
  n <- nrow(d)
  x <- seq_len(n)

  if (is.null(detections)) {
    if (is.null(pattern)) {
      detections <- rep(FALSE, n)
    } else {
      detections <- detect_pattern(d, pattern)
    }
  }
  detections[is.na(detections)] <- FALSE

  if (!is.null(file)) {
    grDevices::png(filename = file, width = 1400, height = 800, res = 130)
    on.exit(grDevices::dev.off(), add = TRUE)
  }

  ylim <- range(c(d$low, d$high), na.rm = TRUE)
  plot(
    x, d$close,
    type = "n",
    xlab = "Index",
    ylab = "Price",
    ylim = ylim,
    main = if (is.null(main)) "Candlestick with Pattern Marks" else main
  )

  up <- d$close >= d$open
  for (i in x) {
    col <- if (up[i]) "#d62728" else "#2ca02c"
    graphics::segments(i, d$low[i], i, d$high[i], col = col, lwd = 1)
    y1 <- min(d$open[i], d$close[i])
    y2 <- max(d$open[i], d$close[i])
    graphics::rect(i - 0.3, y1, i + 0.3, y2, col = col, border = col)
  }

  idx <- which(detections)
  if (length(idx) > 0) {
    graphics::points(idx, d$high[idx] * 1.01, pch = 21, bg = "#1f77b4", col = "white", cex = 1)
    keep <- utils::tail(idx, min(length(idx), max_labels))
    lbl <- if (is.null(pattern)) "pattern" else resolve_pattern_id(pattern)
    graphics::text(keep, d$high[keep] * 1.02, labels = lbl, cex = 0.7, col = "#1f77b4", pos = 3)
  }
  invisible(idx)
}

#' Run a Simulated Screening Demo with Charts
#'
#' Simulates several symbols, runs pattern screening, and writes chart images
#' with pattern labels.
#'
#' @param symbols Character vector of symbols.
#' @param patterns Patterns to screen.
#' @param n Number of rows per symbol.
#' @param seed Random seed.
#' @param output_dir Output directory for PNG charts.
#'
#' @return A list with `data`, `screen`, and `plot_files`.
#'
#' @examples
#' out <- run_simulation_demo(
#'   symbols = c("AAA", "BBB", "CCC"),
#'   patterns = c("double_bottom", "golden_pit"),
#'   n = 180
#' )
#' out$screen
#' @export
run_simulation_demo <- function(
    symbols = c("AAA", "BBB", "CCC"),
    patterns = c("double_bottom", "golden_pit", "ascending_triangle"),
    n = 220,
    seed = 123,
    output_dir = tempdir()) {
  data_list <- simulate_symbols(symbols = symbols, n = n, seed = seed)
  dir.create(output_dir, recursive = TRUE, showWarnings = FALSE)

  all_rows <- list()
  plot_files <- character()
  row_id <- 1L

  for (sym in names(data_list)) {
    d <- data_list[[sym]]
    for (p in patterns) {
      hit <- detect_pattern(d, p)
      if (any(hit, na.rm = TRUE)) {
        idx <- max(which(hit))
        all_rows[[row_id]] <- data.frame(
          symbol = sym,
          pattern = resolve_pattern_id(p),
          detected_index = idx,
          close = d$close[idx],
          stringsAsFactors = FALSE
        )
        row_id <- row_id + 1L
      }

      png_file <- file.path(
        output_dir,
        paste0(sym, "_", resolve_pattern_id(p), ".png")
      )
      plot_kline_patterns(
        d,
        pattern = p,
        detections = hit,
        main = paste(sym, "-", resolve_pattern_id(p)),
        file = png_file
      )
      plot_files <- c(plot_files, png_file)
    }
  }

  screen <- if (length(all_rows) == 0) {
    data.frame(
      symbol = character(),
      pattern = character(),
      detected_index = integer(),
      close = numeric(),
      stringsAsFactors = FALSE
    )
  } else {
    do.call(rbind, all_rows)
  }

  list(
    data = data_list,
    screen = screen,
    plot_files = plot_files
  )
}
