# generate unique ID
.next_eid <- function(prefix = "lessR") {
  counter <- getOption("lessR.widget_counter", 0L) + 1L
  options(lessR.widget_counter = counter)

  # millisecond timestamp as character (no integer overflow)
  stamp <- format(Sys.time(), "%Y%m%d%H%M%OS3")

  sprintf("%s-%s-%d", prefix, stamp, counter)
}




# ----- title builder (consistent across chart types) ---------------------
.plotly_build_title <- function(x_name,
                               by_name   = NULL,
                               facet_name= NULL,
                               y_name    = NULL,
                               stat      = NULL) {
  cap_stat <- function(s) switch(tolower(s),
                                 mean="Mean", sum="Sum", median="Median",
                                 min="Min",  max="Max",  sd="SD",
                                 toupper(s))
  # helper: does y_name already start with a stat word?
  y_has_stat <- function(y) {
    if (is.null(y)) return(FALSE)
    grepl("^(Mean|Sum|Median|Min|Max|SD)\\b", y)
  }
  # helper: detect stat suffix from pivot()-style names like "Salary_mean"
  y_stat_suffix <- function(y) {
    if (is.null(y)) return(NULL)
    m <- regmatches(y, regexpr("_(mean|sum|median|min|max|sd)$",
                               y, ignore.case=TRUE))
    if (length(m) == 0L) NULL else sub("^_", "", m)
  }

  # --- COUNT title only when neither y nor stat is provided ---
  if (is.null(y_name) && is.null(stat)) {
    ttl <- paste("Count of", x_name)
  }
  else if (is.null(stat)) {
    # y_name present but stat missing — likely pre-aggregated data
    suf <- y_stat_suffix(y_name)
    if (!is.null(suf)) {
      # strip suffix and use detected stat
      base_y <- sub("_(mean|sum|median|min|max|sd)$", "", y_name,
                    ignore.case=TRUE)
      ttl    <- paste(cap_stat(suf), "of", base_y, "by", x_name)
    } else if (y_has_stat(y_name)) {
      ttl <- paste(y_name, "by", x_name)
    } else {
      ttl <- paste(y_name, "by", x_name)
    }
  }
  else {
    S <- cap_stat(stat)
    if (y_has_stat(y_name)) {
      ttl <- paste(y_name, "by", x_name)
    } else {
      ttl <- paste(S, "of", y_name, "by", x_name)
    }
  }
  if (!is.null(by_name) && nzchar(by_name)) ttl <- paste(ttl, "by", by_name)
  if (!is.null(facet_name) && nzchar(facet_name))
     ttl <- paste(ttl, "across", facet_name)
  ttl
}


# ----- collected style options for plotly internals ---------------------
# Read once in Chart()/X()/XY() and passed down so plotly fns don't reach
# into getOption() themselves. Defaults match what the prior in-line reads
# applied at each call site.
.plotly_style <- function() {
  pb <- getOption("panel_border", "#808080")
  list(
    axis_color        = getOption("axis_color"),
    axis_text_color   = getOption("axis_text_color"),
    axis_x_color      = getOption("axis_x_color"),
    axis_y_color      = getOption("axis_y_color"),
    axis_x_text_color = getOption("axis_x_text_color"),
    axis_y_text_color = getOption("axis_y_text_color"),
    grid_color        = getOption("grid_color", "gray85"),
    grid_col          = getOption("grid_col",   "gray85"),
    grid_x_color      = getOption("grid_x_color"),
    grid_y_color      = getOption("grid_y_color"),
    lab_color         = getOption("lab_color", "black"),
    legend_border     = getOption("legend_border", pb),
    panel_border      = pb,
    panel_fill        = getOption("panel_fill", "white"),
    plotly_dpi        = getOption("plotly_dpi", 96),
    segment_color     = getOption("segment_color"),
    theme             = getOption("theme"),
    window_fill       = getOption("window_fill", "white")
  )
}


# ----- proportional palette index --------------------------------------
# Map a vector of values into [lo, hi] fraction of a length-n_pal palette.
# Used by .hier_color_resolve() for sequential luminance mapping.
.plotly_prop_idx <- function(vals, n_pal, lo = 0.28, hi = 1.0) {
  mn.s <- min(vals, na.rm = TRUE)
  mx.s <- max(vals, na.rm = TRUE)
  rng  <- mx.s - mn.s
  if (rng > 0)
    round(1 + (lo + (vals - mn.s) / rng * (hi - lo)) * (n_pal - 1))
  else
    rep(round(1 + ((lo + hi) / 2) * (n_pal - 1)), length(vals))
}


# ----- hier-chart fill resolution --------------------------------------
# Returns the per-top-level hex color vector and (if facet supplied) a
# per-facet remapping so sequential palettes span their full luminance
# range within each panel. Replaces the in-line color logic that used to
# live in .hier.plotly().
#
# Returns list(fill_vec, fill_vec_byfac) — both NULL-safe.
#   fill_vec       : named hex vector keyed by top.level (length n.lvl)
#   fill_vec_byfac : NULL when facet is NULL; otherwise a named list
#                    keyed by facet level, each value a named hex vector
#                    keyed by that facet's present top.levels
.hier_color_resolve <- function(x, y, facet, fill, fill.palette,
                                theme, stat) {
  seq.pals <- c("gray", "grays", "grey", "greys",
                "blues", "greens", "reds", "purples",
                "violets", "rusts", "oranges", "browns", "terrain")
  pal.name <- tolower(fill.palette[1L] %||% "")
  is.seq   <- pal.name %in% seq.pals || theme %in% c("gray", "white")

  top.raw <- as.character(x)
  present <- unique(top.raw[!is.na(top.raw)])
  top.levels <- if (is.factor(x)) {
    lv <- levels(x)
    lv[lv %in% present]
  } else present

  STAT     <- tolower(stat %||% "sum")
  stat.fun <- .stat_fun(STAT)

  base.vals <- if (is.null(y)) rep(1, length(top.raw)) else {
    z <- suppressWarnings(as.numeric(y))
    z[!is.finite(z)] <- 0
    z
  }

  # global top.stats (sequential only) — also reorders top.levels by stat
  top.stats <- NULL
  if (is.seq) {
    agg.fun <- if (!is.null(y)) stat.fun
               else function(z) sum(ifelse(is.na(z), 0, 1))
    top.stats <- tapply(base.vals, top.raw, agg.fun)[top.levels]
    ord       <- order(top.stats, decreasing = TRUE)
    top.levels<- top.levels[ord]
    top.stats <- top.stats[ord]
  }

  n.lvl <- length(top.levels)

  big.pal <- if (is.null(fill)) {
    pal <- fill.palette[1L] %||% "hues"
    if (is.seq) .color_range(pal, 256L)
    else .color_range(pal, max(n.lvl, 1L))
  } else fill

  fill.vec <- if (is.seq && !is.null(top.stats) && n.lvl > 1L &&
                  diff(range(top.stats)) > 0) {
    .scale.clr(top.stats, fill=NULL,
      fill_split=0, fill_chroma=75, theme=theme)
  } else if (is.seq) {
    h.v <- if (theme %in% c("gray", "white")) 0 else .get.h(theme)
    c.v <- if (theme %in% c("gray", "white")) 0 else 75
    rep_len(hcl(h=h.v, c=c.v, l=60), max(n.lvl, 1L))
  } else {
    out <- big.pal[seq_len(n.lvl)]
    if (length(out) < n.lvl) out <- rep_len(big.pal, n.lvl)
    out
  }
  fill.vec <- setNames(fill.vec, top.levels)

  fill.vec.byfac <- NULL
  if (!is.null(facet)) {
    fac.chr <- as.character(facet)
    fac.levels <- if (!is.null(levels(facet))) levels(facet)
                  else unique(fac.chr[!is.na(fac.chr)])
    fac.levels <- sort(fac.levels)

    fill.vec.byfac <- setNames(vector("list", length(fac.levels)),
                                fac.levels)
    for (lv in fac.levels) {
      idx <- which(fac.chr == lv)
      if (!is.seq || length(idx) == 0L) {
        # categorical (or empty facet): use global vec
        fill.vec.byfac[[lv]] <- fill.vec
        next
      }
      fac.base  <- base.vals[idx]
      fac.x     <- top.raw[idx]
      fac.stats <- tapply(fac.base, fac.x, stat.fun)
      fac.top   <- top.levels[top.levels %in% names(fac.stats)]
      fac.stats <- fac.stats[fac.top]
      ord.f     <- order(fac.stats, decreasing = TRUE)
      fac.top   <- fac.top[ord.f]
      fac.stats <- fac.stats[ord.f]
      if (length(fac.top) > 1L && diff(range(fac.stats)) > 0) {
        fill.vec.byfac[[lv]] <- setNames(
          .scale.clr(fac.stats, fill=NULL,
            fill_split=0, fill_chroma=75,
            theme=theme),
          fac.top)
      } else {
        h.v <- if (theme %in% c("gray", "white")) 0
               else .get.h(theme)
        c.v <- if (theme %in% c("gray", "white")) 0 else 75
        fill.vec.byfac[[lv]] <- setNames(
          rep_len(hcl(h=h.v, c=c.v, l=60),
                  max(length(fac.top), 1L)),
          fac.top)
      }
    }
  }

  list(fill_vec = fill.vec, fill_vec_byfac = fill.vec.byfac)
}


# ----- hierarchical aggregation ----------------------------------------
# Build the per-level node tables that .hier.plotly() will hand to
# plotly's sunburst/treemap/icicle traces. Called by Chart() so the
# plotly internal stays pure-rendering.
#
# Returns list with:
#   nd            : data frame (ids/labels/parents/values/text/customdata/
#                   root) for the non-faceted call
#   nd_byfac      : named list of nd data frames (one per facet level), or
#                   NULL when facet is NULL
#   stat.label    : "Count" / y_name / "<Stat> of y_name" (hover legend)
#   non.additive  : TRUE when STAT != "sum" (controls label formatting)
#   STAT          : tolower(stat %||% "sum")
.hier_aggregate <- function(x, by = NULL, y = NULL, facet = NULL,
                            stat = NULL,
                            x_name = "X", by_name = NULL,
                            facet_name = "Facet", y_name = "y",
                            digits_d = NULL) {

  mk.char <- function(v) as.character(v)

  if (is.null(by)) {
    path.df   <- data.frame(x = mk.char(x), check.names = FALSE)
    lvl.names <- c(x_name)
  } else if (is.data.frame(by)) {
    tmp <- as.data.frame(lapply(by, mk.char), check.names = FALSE)
    path.df   <- data.frame(x = mk.char(x), tmp, check.names = FALSE)
    lvl.names <- c(x_name, names(tmp))
  } else {
    path.df   <- data.frame(x = mk.char(x), by = mk.char(by),
                            check.names = FALSE)
    lvl.names <- c(x_name, by_name %||% "by")
  }

  path.cols <- names(path.df)
  n.levels  <- length(path.cols)

  base.vals <- if (is.null(y)) rep(1, nrow(path.df)) else {
    z <- suppressWarnings(as.numeric(y))
    z[!is.finite(z)] <- 0
    z
  }

  STAT         <- tolower(stat %||% "sum")
  stat.fun     <- .stat_fun(STAT)

  non.additive <- !identical(STAT, "sum")

  stat.label <- if (is.null(y)) "Count"
                else if (non.additive) paste0(toupper(substr(STAT, 1, 1)),
                                              substr(STAT, 2, nchar(STAT)),
                                              " of ", y_name)
                else y_name

  digits <- if (is.null(digits_d)) 2L else max(0L, as.integer(digits_d))

  # Build the per-level node table for the given row subset. Mirrors the
  # build.nodes closure that used to live in .hier.plotly().
  build_nodes <- function(idx, facet_label = NULL) {
    if (length(idx) == 0L) {
      return(data.frame(
        ids     = character(),
        labels  = character(),
        parents = character(),
        values  = numeric(),
        text    = character(),
        customdata = I(list()),
        root    = character()
      ))
    }

    df  <- path.df[idx, , drop = FALSE]
    val <- base.vals[idx]

    out.ids     <- character(0)
    out.labels  <- character(0)
    out.parents <- character(0)
    out.values  <- numeric(0)
    out.text    <- character(0)
    out.custom  <- list()
    out.root    <- character(0)

    for (lvl in seq_len(n.levels)) {
      cols <- path.cols[1:lvl]
      agg.size <- stats::aggregate(val, by = df[, cols, drop = FALSE],
                                   FUN = stat.fun)
      names(agg.size)[ncol(agg.size)] <- "size"
      agg.stat <- agg.size
      names(agg.stat)[ncol(agg.stat)] <- "stat"

      cur.labels <- mk.char(agg.size[[cols[lvl]]])
      root.vals  <- mk.char(agg.size[[path.cols[1L]]])

      if (lvl == 1L) {
        parents <- rep("", nrow(agg.size))
        ids     <- paste0("I_", cur.labels)
      } else {
        parent.df <- agg.size[, cols[-length(cols)], drop = FALSE]
        parents   <- apply(parent.df, 1, function(r)
          paste0("I_", paste(mk.char(r), collapse = "_")))
        ids       <- paste0(parents, "_", cur.labels)
      }

      meta.lines <- mapply(function(row_i) {
        parts <- character(0)
        for (k in seq_len(lvl))
          parts <- c(parts, paste0(lvl.names[k], ": ",
                                   mk.char(agg.size[row_i, cols[k]])))
        if (!is.null(facet_label))
          parts <- c(parts, paste0(facet_name, ": ", facet_label))
        paste(parts, collapse = "<br>")
      }, seq_len(nrow(agg.size)), SIMPLIFY = TRUE, USE.NAMES = FALSE)

      if (is.null(y)) {
        node.n <- agg.size$size
      } else {
        agg.n <- stats::aggregate(ifelse(is.na(val), 0, 1),
                                  by = df[, cols, drop = FALSE], FUN = sum)
        names(agg.n)[ncol(agg.n)] <- "n"
        key.size <- do.call(paste, c(agg.size[, cols, drop=FALSE], sep="\r"))
        key.n    <- do.call(paste, c(agg.n[, cols, drop=FALSE], sep="\r"))
        node.n   <- agg.n$n[match(key.size, key.n)]
      }

      custom <- Map(
        function(meta_txt, stat_v, n_v)
          list(meta = meta_txt, stat = stat_v, n = n_v, level = lvl),
        meta.lines, agg.stat$stat, node.n
      )

      out.ids     <- c(out.ids,     ids)
      out.labels  <- c(out.labels,  cur.labels)
      out.parents <- c(out.parents, parents)
      out.values  <- c(out.values,
                       if (lvl == n.levels) agg.size$size
                       else                 rep(0, nrow(agg.size)))
      stat.vals   <- agg.stat$stat
      node.text   <- formatC(stat.vals, format = "f", digits = digits)
      out.text    <- c(out.text,    node.text)
      out.custom  <- c(out.custom,  custom)
      out.root    <- c(out.root,    root.vals)
    }

    # top.levels factor ordering is set by Chart's color resolver, not here
    data.frame(
      ids        = out.ids,
      labels     = out.labels,
      parents    = out.parents,
      values     = out.values,
      text       = out.text,
      customdata = I(out.custom),
      root       = out.root,
      stringsAsFactors = FALSE
    )
  }

  nd       <- if (is.null(facet)) build_nodes(seq_len(nrow(path.df)))
              else NULL
  nd_byfac <- NULL
  if (!is.null(facet)) {
    fac.chr    <- mk.char(facet)
    fac.levels <- if (!is.null(levels(facet))) levels(facet)
                  else unique(fac.chr[!is.na(fac.chr)])
    fac.levels <- sort(fac.levels)
    nd_byfac <- setNames(vector("list", length(fac.levels)), fac.levels)
    for (lv in fac.levels) {
      idx <- which(fac.chr == lv)
      nd_byfac[[lv]] <- build_nodes(idx, facet_label = lv)
    }
  }

  list(
    nd           = nd,
    nd_byfac     = nd_byfac,
    stat.label   = stat.label,
    non.additive = non.additive,
    STAT         = STAT,
    n_levels     = n.levels,   # depth: 1 = no by-grouping; 2+ = nested
    has_y        = !is.null(y) # whether y was supplied (affects label/layout)
  )
}


# ----- radar aggregation -----------------------------------------------
# Build the 3-way (facet × by × x) value table that .radar.plotly() will
# render. Called by Chart() so the plotly internal stays pure-rendering.
#
# Returns list with:
#   r.tab     : xtabs 3-way table value ~ facet+by+x
#   facet.fac : factor of facet levels (display order)
#   by.fac    : factor of by levels (display order)
#   x.fac.out : factor of x (axis) levels (display order)
#   rmax      : max value across the table (axis upper bound)
#   n.fac     : length(facet.fac)
#   n.by      : length(by.fac)
#   y.label   : hover-text label ("Count" / y_name / "StatName y_name")
.radar_aggregate <- function(x, by = NULL, facet = NULL, y = NULL,
                             stat = NULL, y_name = "y") {
  n <- length(x)
  if (n == 0L) stop("radar(): x has length 0.")

  x.fac      <- factor(x, levels = sort(unique(x)))
  by.fac.in  <- if (is.null(by))    factor(rep("(All)", n), levels="(All)")
                else factor(by, levels = unique(by))
  fac.fac.in <- if (is.null(facet)) factor(rep("(All)", n), levels="(All)")
                else factor(facet, levels = unique(facet))

  stat.supplied <- !is.null(stat) && nzchar(stat)

  if (is.null(y)) {
    val     <- rep(1, n)
    STAT    <- "sum"
    fun     <- function(z) sum(z, na.rm = TRUE)
    y.label <- "Count"
  } else {
    STAT <- if (stat.supplied) tolower(stat) else "sum"
    fun  <- .stat_fun(STAT)
    val <- suppressWarnings(as.numeric(y))
    val[!is.finite(val)] <- NA_real_

    y.label <- if (stat.supplied) {
      StatName <- switch(STAT,
        mean="Mean", sum="Sum", median="Median",
        min="Min", max="Max", sd="SD", toupper(stat))
      paste(StatName, y_name)
    } else y_name
  }

  df <- data.frame(facet = fac.fac.in, by = by.fac.in,
                   x = x.fac, val = val)
  agg <- stats::aggregate(val ~ facet + by + x, data = df,
                          FUN = fun, drop = FALSE)
  names(agg)[names(agg) == "val"] <- "value"
  r.tab <- xtabs(value ~ facet + by + x, data = agg,
                 drop.unused.levels = FALSE)

  facet.fac <- factor(dimnames(r.tab)[[1]], levels = dimnames(r.tab)[[1]])
  by.fac    <- factor(dimnames(r.tab)[[2]], levels = dimnames(r.tab)[[2]])
  x.fac.out <- factor(dimnames(r.tab)[[3]], levels = dimnames(r.tab)[[3]])

  if (!length(x.fac.out)) stop("radar(): x has no levels to plot.")
  if (!length(by.fac))    stop("radar(): by has no levels to plot.")
  if (!length(facet.fac)) stop("radar(): facet has no levels to plot.")

  rmax <- max(r.tab, na.rm = TRUE)
  if (!is.finite(rmax))
    stop("radar(): all aggregated values are NA; nothing to plot.")

  list(
    r.tab     = r.tab,
    facet.fac = facet.fac,
    by.fac    = by.fac,
    x.fac.out = x.fac.out,
    rmax      = rmax,
    n.fac     = length(facet.fac),
    n.by      = length(by.fac),
    y.label   = y.label
  )
}




# Plots and Viewer window notices ----------------------------------------

if (!exists(".lessR_deprec_env", inherits = FALSE)) {
  .lessR_deprec_env <- new.env(parent = emptyenv())
}

# One-time notice with ANSI color (auto-disables if not supported).
# Persists per R session via options(lessR.seen_notices = list(...)).
# One-time notice (ANSI color only when supported).
# Persists per R session via options(lessR.seen_notices = list(...)).
.viewer_notice_once <- function(plot_name, window_target = "Viewer") {

  # 0) Never print this during knitting / rendering (vignettes, Rmd, Quarto)
  if (isTRUE(getOption("knitr.in.progress"))) return(invisible(NULL))
  if (isTRUE(getOption("quarto.rendering")))  return(invisible(NULL))

  # 1) allow global silence
  if (isTRUE(getOption("lessR.silence_notices", FALSE))) return(invisible(NULL))

  # build a stable key (e.g., "notice_viewer_radar")
  key <- paste0(
    "notice_",
    tolower(gsub("\\s+", "_", window_target)),
    "_",
    tolower(gsub("\\s+", "_", plot_name))
  )

  seen <- getOption("lessR.seen_notices", default = list())
  if (isTRUE(seen[[key]])) return(invisible(NULL))

  # 2) Decide whether to use ANSI sequences (only in interactive terminals)
  use_ansi <- isTRUE(getOption("lessR.use_ansi_notices", TRUE)) &&
              interactive() &&
              nzchar(Sys.getenv("TERM")) &&
              Sys.getenv("TERM") != "dumb" &&
              Sys.getenv("RSTUDIO") != "1"   # RStudio console does not reliably render ANSI

  if (use_ansi) {
    bold     <- "\033[1m"
    unbold   <- "\033[22m"
    darkred  <- "\033[38;5;88m"
    darkblue <- "\033[38;5;19m"
    purple   <- "\033[38;5;93m"
    reset    <- "\033[0m"
  } else {
    bold <- unbold <- darkred <- darkblue <- purple <- reset <- ""
  }

  msg <- switch(
    window_target,
    "Viewer" = paste0(
      " ", darkred, "Viewer", reset, " Window --> Plotly interactive visualization\n",
      "   You may need to properly align the plot by clicking the ", bold, "Refresh button", unbold, " at the\n",
      "   top-right of the Viewer window, especially for legends or labels to display.\n"
    ),
    "Plots" = paste0(
      " ", darkblue, "Plots", reset, " Window --> Static visualization\n",
      "   This chart appears in the Plots pane. Use Export to save or copy.\n"
    ),
    "Both" = paste0(
      " ", purple, "Viewer + Plots", reset, " --> Interactive (Viewer) and static (Plots)\n"
    ),
    paste0(" Output --> Visualization generated in ", window_target, ".\n")
  )

  # Use message() so message=FALSE can suppress in chunks when desired
  message(msg)

  # mark as seen for the remainder of the session
  seen[[key]] <- TRUE
  options(lessR.seen_notices = seen)

  invisible(NULL)
}


# color functions ---------------------------------------------------------

# --- Perceived luminance + black/white auto-contrast -----------------------
.hex_to_rgb3 <- function(h) {
  h <- gsub("#", "", toupper(h))
  if (nchar(h) %in% c(3,4)) {
    h <- paste0(substr(h,1,1), substr(h,1,1),
                substr(h,2,2), substr(h,2,2),
                substr(h,3,3), substr(h,3,3))
  }
  c(strtoi(substr(h,1,2), 16L),
    strtoi(substr(h,3,4), 16L),
    strtoi(substr(h,5,6), 16L))
}

.srgb_to_lin3 <- function(c) {
  c <- c / 255
  ifelse(c <= 0.03928, c / 12.92, ((c + 0.055) / 1.055)^2.4)
}

.contrast_text_for_hex <- function(hex) {
  # expects #RRGGBB (use .to_hex first if needed)
  rgb <- .hex_to_rgb3(hex)
  lin <- .srgb_to_lin3(rgb)
  L   <- 0.2126 * lin[1] + 0.7152 * lin[2] + 0.0722 * lin[3]
  # Compare contrast with white vs black; choose the higher
  if ((1.05) / (L + 0.05) > (L + 0.05) / 0.05) "#FFFFFF" else "#000000"
}
# --------

.resolve_alpha <- function(k, opacity) {
  if (!is.null(opacity)) return(as.numeric(opacity))
  .auto_opacity(k, "fill")
}


.to_hex <- function(col) {
  if (length(col) == 0) return(character(0))
  conv1 <- function(c1) {
    if (is.na(c1)) return(NA_character_)
    c1 <- trimws(as.character(c1))

    # --- rgb()/rgba(): retain alpha if present ----------------------------
    m <- regexec("^rgba?\\(([^)]+)\\)$", c1, perl = TRUE)
    g <- regmatches(c1, m)[[1]]
    if (length(g)) {
      parts <- as.numeric(strsplit(g[2], "\\s*,\\s*")[[1]])
      r  <- as.integer(round(pmax(0, pmin(255, parts[1]))))
      g1 <- as.integer(round(pmax(0, pmin(255, parts[2]))))
      b  <- as.integer(round(pmax(0, pmin(255, parts[3]))))
      if (length(parts) == 4) {                          # rgba() has alpha
        a <- as.integer(round(pmax(0, pmin(1, parts[4])) * 255))
        return(sprintf("#%02X%02X%02X%02X", r, g1, b, a))
      }
      return(sprintf("#%02X%02X%02X", r, g1, b))
    }

    # --- #RRGGBB  ----------------------------------------------------------
    if (grepl("^#[0-9A-Fa-f]{6}$", c1)) return(c1)

    # --- #RGB -> expand ----------------------------------------------------
    if (grepl("^#[0-9A-Fa-f]{3}$", c1)) {
      r <- substr(c1, 2, 2); g1 <- substr(c1, 3, 3); b <- substr(c1, 4, 4)
      return(paste0("#", r, r, g1, g1, b, b))
    }

    # --- #RRGGBBAA: keep as-is --------------------------------------------
    if (grepl("^#[0-9A-Fa-f]{8}$", c1)) return(c1)

    # --- named colors -> col2rgb, retain alpha if present -----------------
    rgb <- grDevices::col2rgb(c1, alpha = TRUE)
    a <- rgb[4, 1]
    if (a < 255L)
      sprintf("#%02X%02X%02X%02X", rgb[1,1], rgb[2,1], rgb[3,1], a)
    else
      sprintf("#%02X%02X%02X", rgb[1,1], rgb[2,1], rgb[3,1])
  }

  col <- ifelse(tolower(trimws(col)) == "off", "transparent", col)
  vapply(col, conv1, "", USE.NAMES = FALSE)
}


# Accepts: #RRGGBB, #RRGGBBAA, #RGB, named colors, or already rgba()
# Returns: rgba(r,g,b,a) with a in [0,1], preserving alpha if present
# shim: convert any color to Plotly rgba(), with alpha boosted for visual parity
# alpha_adjust: add e.g. +0.25 if Plotly looks too transparent
.as_plotly_rgba <- function(col, alpha_adjust = 0) {
  sapply(col, function(c1) {
    s <- trimws(c1)
    if (!nzchar(s)) return("rgba(0,0,0,0)")
    if (grepl("^#[0-9A-Fa-f]{8}$", s)) {
      r <- strtoi(substr(s, 2, 3), 16L)
      g <- strtoi(substr(s, 4, 5), 16L)
      b <- strtoi(substr(s, 6, 7), 16L)
      a <- strtoi(substr(s, 8, 9), 16L) / 255
    } else if (grepl("^#[0-9A-Fa-f]{6}$", s)) {
      r <- strtoi(substr(s, 2, 3), 16L)
      g <- strtoi(substr(s, 4, 5), 16L)
      b <- strtoi(substr(s, 6, 7), 16L)
      a <- 1
    } else {
      rgbm <- grDevices::col2rgb(s)
      r <- rgbm[1,1]; g <- rgbm[2,1]; b <- rgbm[3,1]; a <- 1
    }
    a <- max(0, min(1, a + alpha_adjust))
    sprintf("rgba(%d,%d,%d,%.3f)", r, g, b, a)
  }, USE.NAMES = FALSE)
}


# Lighten colors toward white by 'amount' in [0,1]. Vectorized; returns hex.
.lighten_plotly <- function(col, amount = 0.35) {
  if (!length(col)) return(character(0))
  amount  <- max(0, min(1, as.numeric(amount[1])))
  col_chr <- as.character(col)

  # If any entries are rgba(...), strip alpha -> rgb(...) so col2rgb can parse
  is_rgba <- grepl("^\\s*rgba\\(", col_chr, ignore.case = TRUE)
  if (any(is_rgba)) {
    col_chr[is_rgba] <- sub(
      "^\\s*rgba\\s*\\(([^,]+),([^,]+),([^,]+),.*\\)\\s*$",
      "rgb(\\1,\\2,\\3)", col_chr[is_rgba], ignore.case = TRUE
    )
  }

  # Vectorized col2rgb; fallback element-wise if needed
  M <- tryCatch(
    grDevices::col2rgb(col_chr, alpha = FALSE),
    error = function(e) {
      mm <- sapply(col_chr, function(cc)
        tryCatch(grDevices::col2rgb(cc, alpha = FALSE)[, 1],
                 error = function(e) c(NA_real_, NA_real_, NA_real_)))
      if (is.null(dim(mm))) dim(mm) <- c(3L, length(col_chr))
      mm
    }
  )
  if (is.null(dim(M))) dim(M) <- c(3L, length(col_chr))  # handle single color case

  # Replace NA channels with a neutral mid-gray to avoid rgb() failure
  M[is.na(M)] <- 204

  # Lighten toward white while PRESERVING DIMENSIONS (avoid pmin/pmax)
  M2 <- M * (1 - amount) + 255 * amount
  M2 <- round(M2)
  M2[M2 < 0]   <- 0
  M2[M2 > 255] <- 255
  dim(M2) <- dim(M)  # ensure still 3 x n

  grDevices::rgb(M2[1, ] / 255, M2[2, ] / 255, M2[3, ] / 255)
}


# Adaptive opacity tuned for overlays/fills so traces remain distinguishable.
# Linear adaptive opacity: opacity = 0.65 - 0.058 * k
# k = number of overlapping groups/traces
.auto_opacity <- function(k, mode = c("overlay","fill","lines","stack")) {
  mode <- match.arg(mode)
  k <- max(1L, as.integer(k))

  # base line (your fit)
  base <- 0.65 - 0.058 * k
  if (k == 1L) base <- 1.00  # single series should be fully opaque

  # mode-specific clamps
  rng <- switch(mode,
    overlay = c(0.28, 0.80),  # barpolar overlays
    fill    = c(0.20, 0.65),  # radar polygon fills
    lines   = c(0.40, 0.90),  # line-only traces
    stack   = c(1.00, 1.00)   # stacks don't need transparency
  )

  opacity <- max(rng[1], min(rng[2], base))
  as.numeric(opacity)
}


# Uniform or per-point transparency for FILL colors
# col   : character vector of colors (names or hex)
# alpha : numeric in [0,1]; scalar or same length as 'col'
# recycle: if TRUE, recycle 'alpha' to length(col)
.maketrans_plotly <- function(col, alpha, recycle = TRUE) {
  if (missing(alpha)) stop(".maketrans_plotly(): 'alpha' is required")
  if (!length(col))   return(character(0))

  col_chr <- as.character(col)
  if (recycle) alpha <- rep_len(alpha, length(col_chr))
  a <- pmax(0, pmin(1, as.numeric(alpha)))

  out <- character(length(col_chr))
  lc  <- trimws(tolower(col_chr))

  # transparent / missing shortcuts
  special <- is.na(col_chr) | lc %in% c("", "na", "transparent", "off")
  out[special] <- "rgba(0,0,0,0)"

  # already rgba(): replace alpha
  is_rgba <- grepl("^rgba\\s*\\(", lc)
  if (any(is_rgba & !special)) {
    idx <- which(is_rgba & !special)
    out[idx] <- sub(
      pattern = "rgba\\s*\\(([^,]+),([^,]+),([^,]+),[^\\)]+\\)\\s*$",
      replacement = function(m) {
        # keep r,g,b; swap a
        paste0("rgba(", sub("rgba\\s*\\(|\\)\\s*$", "", regmatches(col_chr[idx], regexpr("rgba\\s*\\([^\\)]*\\)", col_chr[idx]))), ")")
      },
      x = col_chr[idx]
    )
    # Now apply the new alpha cleanly
    # Parse r,g,b fast:
    rgbm <- grDevices::col2rgb(sub("^rgba\\s*\\(", "rgb(", col_chr[idx]))
    out[idx] <- sprintf("rgba(%d,%d,%d,%.3f)", rgbm[1,], rgbm[2,], rgbm[3,], a[idx])
  }

  # normal colors (hex/named)
  norm <- !special & !is_rgba
  if (any(norm)) {
    idx <- which(norm)
    rgbm <- grDevices::col2rgb(col_chr[idx])
    out[idx] <- sprintf("rgba(%d,%d,%d,%.3f)", rgbm[1, ], rgbm[2, ], rgbm[3, ], a[idx])
  }
  out
}


# Opaque border color for Plotly markers/lines (forces a = 1)
.to_plotly_color <- function(col) {
  if (!length(col)) return(character(0))
  col_chr <- as.character(col)
  special <- is.na(col_chr) |
             trimws(tolower(col_chr)) %in% c("", "na", "transparent", "off")
  out <- character(length(col_chr))
  out[special] <- "rgba(0,0,0,0)"  # invisible border if asked to be transparent

  if (any(!special)) {
    idx  <- which(!special)
    rgbm <- grDevices::col2rgb(col_chr[idx])
    out[idx] <- sprintf("rgba(%d,%d,%d,1.000)", rgbm[1, ], rgbm[2, ], rgbm[3, ])
  }
  out
}


# Choose/recycle by names (used everywhere)
.pick_by_names_or_recycle <- function(v, needed_names, needed_len, fallback=NULL) {
  v <- as.character(v); nm <- names(v)
  if (!is.null(nm) && length(nm)) {
    out <- v[match(needed_names, nm)]
    if (anyNA(out)) {
      base <- if (length(v)) v else (fallback %||% grDevices::hcl.colors(needed_len, "Dark 3"))
      out[is.na(out)] <- base[((which(is.na(out)) - 1L) %% length(base)) + 1L]
    }
    return(out)
  }
  if (!length(v)) {
    return(if (!is.null(fallback)) rep_len(fallback, needed_len)
           else grDevices::hcl.colors(needed_len, "Dark 3"))
  }
  rep_len(v, needed_len)
}


# ---- hover format -------------------------------------------------------

.get.tick.fmt <- function(v, digits_d = 2) {
  if (is.null(digits_d)) digits_d <- 2
  if (.is.integer(v)) {
    ""                        # integers: no format
  } else {
    paste0(".", digits_d, "f")  # floats: d3-format string
  }
}

.hover.fmt <- function(x, y, x.lab, y.lab, horiz=FALSE,
                       digits_d=2, ts_unit=NULL) {

  fmtx <- .get.tick.fmt(x, digits_d)
  fmty <- .get.tick.fmt(y, digits_d)

  addfmt <- function(var, fmt) {
    if (nzchar(fmt)) paste0("%{", var, ":", fmt, "}") else paste0("%{", var, "}")
  }

  if (!horiz) {
    # vertical scatter: first line shows X name + value
    paste0(
      x.lab, ": ", if(is.null(ts_unit)) addfmt("x", fmtx) else x,
      "<br>", y.lab, ": ", addfmt("y", fmty),
      "<extra></extra>"
    )
  }
  else {
    # horizontal scatter: first line shows Y name + value
    paste0(
      y.lab, ": ", addfmt("y", fmty),
      "<br>", x.lab, ": ", addfmt("x", fmtx),
      "<extra></extra>"
    )
  }
}


.grid_style <- function() {
  list(
    color = .to_hex(getOption("grid_col", "gray85")),  # convert here
    width = getOption("grid_lwd", 0.5),
    dash  = getOption("grid_lty", NULL)
  )
}

x_grid <- function(x_vals, xref="x", yref="paper", y0=0, y1=1,
                   color=NULL, width=NULL, dash=NULL, layer="below") {
  if (is.null(x_vals) || !length(x_vals)) return(list())
  st  <- .grid_style()
  col <- if (is.null(color)) st$color else color
  wid <- if (is.null(width)) st$width else width
  dsh <- if (is.null(dash))  st$dash  else dash

  # ensure hex for Plotly
  col <- .to_hex(col)

  lapply(x_vals, function(x0) {
    list(
      type  = "line",
      xref  = xref, yref = yref,
      x0    = x0, x1 = x0,
      y0    = y0, y1 = y1,
      line  = c(list(color = col, width = wid),
                if (!is.null(dsh)) list(dash = dsh) else list()),
      layer = layer
    )
  })
}


y_grid <- function(y_vals, xref="paper", yref="y", x0=0, x1=1,
                   color=NULL, width=NULL, dash=NULL, layer="below") {
  if (is.null(y_vals) || !length(y_vals)) return(list())
  st  <- .grid_style()
  col <- if (is.null(color)) st$color else color
  wid <- if (is.null(width)) st$width else width
  dsh <- if (is.null(dash))  st$dash  else dash

  col <- .to_hex(col)

  lapply(y_vals, function(y0) {
    list(
      type  = "line",
      xref  = xref, yref = yref,
      y0    = y0, y1 = y0,
      x0    = x0, x1 = x1,
      line  = c(list(color = col, width = wid),
                if (!is.null(dsh)) list(dash = dsh) else list()),
      layer = layer
    )
  })
}


axis_base <- function() {
        
# ax <- list(
  list(
    zeroline  = FALSE, showline = TRUE,
    linecolor = .to_hex(getOption("axis_color", "black")),
    linewidth = getOption("axis_lwd", 1),
    ticks     = "outside", ticklen = 4,
    automargin = TRUE,
    tickfont = list(
      color  = .to_hex(getOption("axis_color", "black")),
      size   = 16 * getOption("axis_size", 0.9)
    ),
    title = list(
      font = list(
        color = .to_hex(getOption("lab_color", "black")),
        size  = 15 * getOption("lab_size", 1)
      ),
      standoff = 10   # try larger than before
    ),
#   showgrid  = getOption("axis_showgrid", TRUE),
    gridcolor = .to_hex(getOption("grid_color", "gray90")),
    gridwidth = getOption("grid_lwd", 1)
  )
}


axis_num <- function(title_txt, tickvals, ticktext) {
  utils::modifyList(axis_base(), list(
    title      = list(text = title_txt),
    tickmode   = "array",
    tickvals   = tickvals,
    ticktext   = ticktext,
    showgrid = FALSE
  ))
}


# categorical axis: grid off
axis_cat <- function(title_txt) {
  utils::modifyList(
    axis_base(),
    list(title = list(text=title_txt), showgrid=FALSE)
  )
}


# Draw top/right frame lines inside the plotting area
plot_border <- function(top = TRUE, right = TRUE,
                        color = getOption("panel_border"),
                        width = getOption("panel_lwd")) {

  if (is.character(color) && grepl("^gray[0-9]+$", color)) 
    color <- "gray75"  # make a gray a little lighter for plotly 

  out <- list()
  if (isTRUE(top)) {
    out[[length(out)+1]] <- list(
      type  = "line",
      xref  = "paper", yref = "paper",
      x0 = 0, x1 = 1, y0 = 1, y1 = 1,
      line = list(color = .to_hex(color), width = width)
    )
  }
  if (isTRUE(right)) {
    out[[length(out)+1]] <- list(
      type  = "line",
      xref  = "paper", yref = "paper",
      x0 = 1, x1 = 1, y0 = 0, y1 = 1,
      line = list(color = .to_hex(color), width = width)
    )
  }
  out
}


legend_base <- function() {
  fam <- getOption("legend_family", NULL)
  leg <- list(
    font = list(
      color = .to_hex(getOption("legend_color", getOption("lab_color", "black"))),
      size  = 15 * getOption("legend_cex", getOption("lab_size", 1))
    )
  )
  if (!is.null(fam)) leg$font$family <- fam
  leg
}


.nudge_viewer <- function(w) {
  # Coerce plotly -> htmlwidget if needed
  if (!inherits(w, "htmlwidget")) {
    if (inherits(w, "plotly")) {
      w <- plotly::plotly_build(w)
    } else {
      return(w)  # not a widget; don’t try to onRender
    }
  }

  htmlwidgets::onRender(
    w,
    "
    function(el, x){
      requestAnimationFrame(function(){
        if(window.Plotly) Plotly.Plots.resize(el); });
      setTimeout(function(){ if(window.Plotly) Plotly.Plots.resize(el); }, 150);
      setTimeout(function(){ if(window.Plotly) Plotly.Plots.resize(el); }, 400);
    }
    "
  )
}


# --- Optional: legend typography across all plotly charts -------------------
.apply_common_legend <- function(p, title_text = NULL) {
  p <- plotly::layout(
    p,
    legend = list(
      title = list(text = title_text %||% "", font = list(size = 13)),
      font  = list(size = 12),
      itemsizing = "constant"
    )
  )
  p
}

.legend_style <- function(by_name = NULL) {
  list(
    title = list(
      text = by_name,
      font = list(size = 14, family = "Arial", color = "black")
    ),
    font = list(size = 13, family = "Arial", color = "black"),
    orientation = "v",
    x = 1.02, y = 0.5,
    xanchor = "left", yanchor = "middle",
    bgcolor = "rgba(255,255,255,0.6)",
    bordercolor = "#CCCCCC",
    borderwidth = 1,
    tracegroupgap = 6
  )
}


# Legend style: same look everywhere
.legend_box <- function(by_name=NULL) {
  if (!is.null(by_name)) {
    list(
      title = list(text = by_name, font = list(size = 12, family = "Arial", color = "black")),
      orientation = "v",
      x = 1.05, y = 0.5, xanchor = "left", yanchor = "middle",
      bgcolor = "rgba(255,255,255,0.9)",
      bordercolor = "#CCCCCC",
      borderwidth = 1
    )
  } else {
    list(orientation = "v", bgcolor = "rgba(255,255,255,0.0)")
  }
}




# Should an interactive plotly chart auto-display?
# User can override with options(lessR.use_plotly = FALSE)
.allow.interactive <- function() {
  opt <- getOption("lessR_interactive", TRUE)
  isTRUE(opt) && base::interactive()
}



# nudge viewer to address RStudio bug of mis-alignment
force_viewer_reload <- function(plt, delays = c(16, 90, 250, 600, 1200)) {

  js <- sprintf(
"(function(){
  return function(el){
    var kicks = [%s];
    var lastW = -1, lastH = -1;

    function measurable(){
      if (!el) return false;
      if (!(el.offsetParent || el.getClientRects().length)) return false;
      var r = el.getBoundingClientRect();
      return (r.width > 0 && r.height > 0);
    }

    function doKick(){
      try {
        if (!measurable()) return false;
        var r = el.getBoundingClientRect();
        if (window.Plotly && el && el.data) {
          try { Plotly.relayout(el, {autosize: true}); } catch(e){}
          try { Plotly.Plots.resize(el); } catch(e){}
        } else {
          try { window.dispatchEvent(new Event('resize')); } catch(e){}
        }
        lastW = r.width; lastH = r.height;
        return true;
      } catch(e) { return false; }
    }

    function guardedKick(deadlineMs){
      var t0 = Date.now();
      (function loop(){
        if (doKick()) return;
        if (deadlineMs && (Date.now() - t0) > deadlineMs) return;
        setTimeout(loop, 32);
      })();
    }

    // Early kicks
    try { requestAnimationFrame(function(){ guardedKick(250); }); } catch(e){}
    try { requestAnimationFrame(function(){
      requestAnimationFrame(function(){ guardedKick(250); });
    }); } catch(e){}

    // Staggered delayed kicks (FIXED)
    for (var i=0; i<kicks.length; i++) {
      (function(d){
        setTimeout(function(){ guardedKick(0); }, d);
      })(kicks[i]);
    }

    // ResizeObserver
    if (typeof ResizeObserver !== 'undefined') {
      try {
        var ro = new ResizeObserver(function(){
          var r = el.getBoundingClientRect();
          if (r.width !== lastW || r.height !== lastH) doKick();
        });
        ro.observe(el);
        if (el.parentElement) ro.observe(el.parentElement);
      } catch(e){}
    }

    // MutationObserver (can be heavy, but keeping your intent)
    try {
      var mo = new MutationObserver(function(){ guardedKick(0); });
      mo.observe(document.documentElement, {attributes:true, childList:true, subtree:true});
    } catch(e){}

    window.addEventListener('focus', function(){ guardedKick(250); });
    document.addEventListener('visibilitychange', function(){
      if (!document.hidden) guardedKick(250);
    });

    // One last kick after full load (FIXED TYPO)
    if (document.readyState !== 'complete') {
      window.addEventListener('load', function(){ guardedKick(250); }, {once:true});
    } else {
      guardedKick(250);
    }
  }
})();",
    paste(as.integer(delays), collapse = ",")
  )

  htmlwidgets::onRender(plt, js)
}


# -------------------------------------------------------------------
# Finalize a plotly widget (or payload) for lessR
#   - Adds optional title
#   - Pins plotly.js dependency if available
#   - Makes widget responsive in RStudio Viewer
#   - Optionally nudges the Viewer for correct sizing
#   - NOW: robust to vector x_name/by_name (collapses them neatly)
# -------------------------------------------------------------------
.finalize_plotly_widget <- function(
  plt,
  kind,
  x_name = NULL,
  by_name = NULL,
  add_title = TRUE,
  nudge_viewer = TRUE,
  unique_element = TRUE   # if TRUE, force a unique elementId to avoid stale mounts
) {

  # collapse name vectors (safe for scalars, NULL)
  .collapse_names <- function(nm, sep = " \u2192 ") {  # default arrow
    if (is.null(nm) || !length(nm)) return(NULL)
    nm_chr <- trimws(as.character(nm))
    nm_chr <- nm_chr[nchar(nm_chr) > 0]
    if (!length(nm_chr)) return("")
    if (length(nm_chr) == 1L) return(nm_chr)
    paste(nm_chr, collapse = sep)
  }

  # choose separators for titles/meta
  x_name_coll  <- .collapse_names(x_name,  sep = " + ")
  by_name_coll <- .collapse_names(by_name, sep = " \u2192 ")

  # ---- title builder --------------------------------------------------------
  .mk_title <- function(xn, byn) {
    xn  <- trimws(as.character(xn %||% ""))
    byn <- trimws(as.character(byn %||% ""))
    if (nzchar(xn) && nzchar(byn)) paste0(xn, " by ", byn)
    else if (nzchar(xn)) xn
    else if (nzchar(byn)) byn
    else ""
  }

  # ---- attach meta used by savePlotly() etc. --------------------------------
  tag_meta <- function(obj) {
    attr(obj, "lessR_kind")   <- as.character(kind %||% "plotly")
    attr(obj, "lessR_xname")  <- as.character(x_name_coll %||% "")
    attr(obj, "lessR_byname") <- as.character(by_name_coll %||% "")
    attr(obj, "lessR_title")  <- .mk_title(x_name_coll, by_name_coll)
    obj
  }

  # helper: millisecond timestamp as character (no integer overflow)
  .ms_chr <- function() format(Sys.time(), "%Y%m%d%H%M%OS3")

  # helper: per-session sequence counter via options()
  .next_seq <- function() {
    s <- getOption("lessR.seq", 0L)
    s <- s + 1L
    options(lessR.seq = s)
    s
  }

  # ---- normalize plotly -> htmlwidget if needed -----------------------------
  if (inherits(plt, "plotly") && !inherits(plt, "htmlwidget")) {
    plt <- plotly::plotly_build(plt)
  }

  # ---- Case A: raw payload list with $data/$layout --------------------------
  if (is.list(plt) && is.null(plt$x) && !is.null(plt$data)
                   && !is.null(plt$layout)) {
    if (isTRUE(add_title)) {
      ttl <- .mk_title(x_name_coll, by_name_coll)
      if (nzchar(ttl)) {
        if (is.null(plt$layout)) plt$layout <- list()
        plt$layout$title <- list(text = ttl)
      }
    }
    plt <- tag_meta(plt)
    options(lessR.last_plotly = plt)
    return(invisible(plt))
  }

  # ---- Case B: htmlwidget (standard) ----------------------------------------
  if (inherits(plt, "htmlwidget")) {

    # (1) Optional title injection
    if (isTRUE(add_title)) {
      ttl <- .mk_title(x_name_coll, by_name_coll)
      if (nzchar(ttl)) {
        plt$x$layout <- plt$x$layout %||% list()
        plt$x$layout$title <- list(text = ttl)
      }
    }

    # (2) Meta for downstream helpers
    plt <- tag_meta(plt)

    # (3) Optionally force a unique elementId to avoid stale mount issues in Viewer
    if (isTRUE(unique_element)) {
      stamp <- .ms_chr()      # "YYYYmmddHHMMSSmmm" as character
      pid   <- Sys.getpid()
      seqn  <- .next_seq()
      plt$elementId <- sprintf("lessr-%s-%d-%d", stamp, pid, seqn)
    }

    # (4) (optional) pin plotly.js — left disabled/commented by default
    # if (exists(".pin_plotly_js", mode = "function")) {
    #   plt <- .pin_plotly_js(plt)
    # } else if (requireNamespace("htmltools", quietly = TRUE)) {
    #   js_path <- system.file("htmlwidgets/lib/plotlyjs/plotly-2.34.0.min.js",
    #                          package = "lessR")
    #   if (nzchar(js_path)) {
    #     dep <- htmltools::htmlDependency(
    #       name    = "plotly-main",
    #       version = "2.34.0",
    #       src     = c(file = dirname(js_path)),
    #       script  = basename(js_path)
    #     )
    #     plt <- htmltools::attachDependencies(plt, dep, append = FALSE)
    #   }
    # }

    # (5) Register last widget for savePlotly()
    options(lessR.last_plotly = plt)
    plt$x$layout <- plt$x$layout %||% list()
    plt$x$layout$autosize <- TRUE
    plt$x$layout$margin <- utils::modifyList(
      list(t = 40, r = 20, b = 40, l = 60, autoexpand = TRUE),
      plt$x$layout$margin %||% list(),
      keep.null = TRUE
    )
    plt$x$config <- utils::modifyList(plt$x$config %||% list(),
                                      list(responsive = TRUE),
                                      keep.null = TRUE)

    # ensure the widget fills the Viewer pane (avoid fixed pixels)
    plt$sizingPolicy <- htmlwidgets::sizingPolicy(
      viewer.fill   = TRUE,
      browser.fill  = TRUE,
      padding       = 0,
      defaultWidth  = NULL,
      defaultHeight = NULL
    )

    # (6) Viewer robustness: autosize + responsive + margins + fill container
    if (isTRUE(nudge_viewer)) {
      plt <- force_viewer_reload(plt, delays = c(16, 90, 250, 600, 1200))
    }

    return(invisible(plt))
  }
}


.force_full_plotly_js <- function(widget, version = "2.34.0") {
  # Path to vendored full Plotly.js inside *this* package
  js_dir <- system.file("htmlwidgets", "lib", "plotlyjs", package = "lessR")
  file_ok <- nzchar(js_dir) &&
            file.exists(file.path(js_dir, sprintf("plotly-%s.min.js", version)))
  if (!file_ok) {
    warning(
      "Full Plotly.js not found at inst/htmlwidgets/lib/plotlyjs/. ",
      "Sunburst may not render in RStudio Viewer. ",
      "Expected file: plotly-", version, ".min.js"
    )
    return(widget)
  }

  dep <- htmltools::htmlDependency(
    name    = "plotlyjs-full",
    version = version,
    src     = c(file = js_dir),
    script  = sprintf("plotly-%s.min.js", version)
  )

  # PREPEND our full Plotly dep so it overrides any partial one
  deps_existing <- htmltools::htmlDependencies(widget)
  deps_new <- c(list(dep), deps_existing)

  htmltools::attachDependencies(widget, deps_new, append = FALSE)
}



# ==== Common Plotly helpers for lessR facet charts =========================

# ----- small utility -----------------------------------------------------
`%||%` <- function(a, b) if (is.null(a) || length(a) == 0L) b else a

# ----- qualitative palette (lessR sequence) ------------------------------
.plotly_base_colors <- function() {
  c(
    "#4398D0","#B28B2A","#5FA140","#D57388",
    "#9A84D6","#00A898","#C97E5B","#909711",
    "#00A3BA","#D26FAF","#00A76F","#BD76CB"
  )
}

# make rgba fills from hex vector (stable indices across facets)
.plotly_make_fills <- function(cols, alpha = 0.30) {
  to_rgba <- function(hex) {
    rgb <- grDevices::col2rgb(hex)
    sprintf("rgba(%d,%d,%d,%.3f)", rgb[1], rgb[2], rgb[3], alpha)
  }
  vapply(cols, to_rgba, character(1))
}

# ----- canonical facet-configuration bundle ------------------------------
# Single config contract for the plotly facet internals (dot.plotly,
# .radar.plotly, .hier.plotly). Defaults live here, in one place. Each
# chart type reads only the fields it uses: dot reads n_row/n_col (its
# grid comes from plotly::subplot); radar/hier read gap_x/gap_y/facet_size
# and the title offsets. A uniform struct with per-type consumption.
.plotly_facet_opts <- function(
  n_row        = NULL, n_col = NULL, n_col_max = 3L,
  gap_x        = 0.04, gap_y = 0.11, facet_size = 1.0,
  title_y_base = -0.018, title_row_shift = -0.003
) list(n_row = n_row, n_col = n_col, n_col_max = n_col_max,
       gap_x = gap_x, gap_y = gap_y, facet_size = facet_size,
       title_y_base = title_y_base, title_row_shift = title_row_shift)


# ----- grid of facet domains (equal sizes) -------------------------------
# returns list(domains=..., n_row=..., n_col=...)
.plotly_make_domains_grid <- function(n_fac, n_col_max = 3L,
                                      gap_x = 0.04, gap_y = 0.11,
                                      facet_size = 1.0) {
  n_col <- min(n_col_max, n_fac)
  n_row <- ceiling(n_fac / n_col)

  width  <- max(0.01, (1 - (n_col + 1) * gap_x) / n_col)
  height <- max(0.01, (1 - (n_row + 1) * gap_y) / n_row)

  domains <- vector("list", n_fac)
  k <- 1L
  for (r in seq_len(n_row)) {
    for (c in seq_len(n_col)) {
      if (k > n_fac) break

      # base cell
      x0 <- gap_x + (c - 1) * (width + gap_x)
      x1 <- x0 + width
      y1 <- 1 - (r - 1) * (height + gap_y)
      y0 <- y1 - height

      # --- center-preserving scaling (keeps charts from drifting up) ---
      cx <- (x0 + x1) / 2
      cy <- (y0 + y1) / 2
      half_w <- (x1 - x0) * facet_size / 2
      half_h <- (y1 - y0) * facet_size / 2

      x0s <- max(0, cx - half_w); x1s <- min(1, cx + half_w)
      y0s <- max(0, cy - half_h); y1s <- min(1, cy + half_h)

      domains[[k]] <- list(x = c(x0s, x1s), y = c(y0s, y1s), row = r, col = c)
      k <- k + 1L
    }
  }
  list(domains = domains, n_row = n_row, n_col = n_col)
}




# ----- facet title annotations -------------------------------------------
.plotly_facet_annotations <- function(domains, facet_levels, facet_name,
                                      y_base = 0.054,
                                      y_row_shift = -0.002,
                                      font_size = 14) {

  ann <- vector("list", length(domains))
  for (i in seq_along(domains)) {
    d <- domains[[i]]
    # supply a default row/col so callers using externally-supplied domains
    # (no grid computation) still get a sensible y position
    row.i <- d$row %||% 1L
    y_title <- d$y[2] + y_base + y_row_shift * (row.i - 1L)
    ann[[i]] <- list(
      text = paste0(facet_name, ": ", facet_levels[i]),
      x = mean(d$x), y = y_title,
      xref = "paper", yref = "paper",
      xanchor = "center", yanchor = "top",
      showarrow = FALSE, font = list(size = font_size)
    )
  }
  ann
}


# ----- unified facet layout (domains + annotations) ----------------------
# Single helper for the three plotly internals (.hier.plotly, .radar.plotly,
# dot.plotly) that need both a panel-grid layout AND per-panel title
# annotations. Internally calls .plotly_make_domains_grid +
# .plotly_facet_annotations with hooks for per-chart-type tweaks.
#
# Returns list(domains = ..., annotations = ...).
#
# Modes:
#   - Supply n_fac (no domains)              : compute grid here
#   - Supply domains (skip grid)             : use them as-is (dot's
#                                              post-subplot extraction)
#
# Hooks:
#   domain_adjust   = function(d) -> d       per-cell domain tweak
#   reverse_domains = TRUE                   reverse final domain order
#                                            (treemap row-bottom-to-top fix)
#   ann_adjust      = function(i, a, d) -> a per-annotation final tweak
.plotly_facet_layout <- function(
  n_fac           = NULL,
  facet_levels,
  facet_name      = "",
  n_col_max       = 3L,
  gap_x           = 0.04, gap_y = 0.11,
  facet_size      = 1.0,
  domains         = NULL,
  domain_adjust   = NULL,
  reverse_domains = FALSE,
  y_base          = 0.054,
  y_row_shift     = -0.002,
  yanchor         = "top",
  font_size       = round(14 * getOption("lab_size", 1)),
  ann_adjust      = NULL
) {
  if (is.null(domains)) {
    grid    <- .plotly_make_domains_grid(n_fac, n_col_max,
                                         gap_x, gap_y, facet_size)
    domains <- grid$domains
  }
  if (!is.null(domain_adjust))
    domains <- lapply(domains, domain_adjust)
  if (isTRUE(reverse_domains))
    domains <- rev(domains)

  annotations <- .plotly_facet_annotations(
    domains, facet_levels, facet_name,
    y_base = y_base, y_row_shift = y_row_shift, font_size = font_size)

  if (yanchor != "top")
    annotations <- lapply(annotations, function(a) {
      a$yanchor <- yanchor; a
    })

  if (!is.null(ann_adjust))
    annotations <- lapply(seq_along(annotations),
                          function(i) ann_adjust(i, annotations[[i]],
                                                 domains[[i]]))

  list(domains = domains, annotations = annotations)
}



# display or summarize an already-built table, x.tbl
# output: formatted to the R console






