.hier.plotly <- function(
  x.call, by.call = NULL, facet.call = NULL, y.call = NULL,
  x.name = "X", by.name = "Group", facet.name = "Facet", y.name = "Y",
  type = "sunburst",
  stat = "sum",
  fill = NULL,
  fill_palette = NULL,
  border = NULL,
  theme = getOption("theme"),
  digits_d = NULL,
  facet_gap_x = if (type != "icicle") 0.04 else 0,
  facet_gap_y = 0.11,
  facet_size = 1.00, facet_title_y_base = -0.018,
  facet_title_row_shift = -0.003,
  main = NULL,
  title_x = NULL,
  show_labels = TRUE,
  labels = c("input", "%", "prop", "off"),
  labels_position = c("in", "out"),
  labels_color = "white",
  labels_size  = 0.75,
  ...
) {


# add trace function ------------------------------------------------------

  make_trace <- function(p, nd, domain_xy) {
    if (!is.null(stat) && isTRUE(digits_d == 0)) digits_d <- digits_d + 2  # mean, etc.

    digits <- if (is.null(digits_d)) 2L else max(0L, as.integer(digits_d))
    fmt_spec <- paste0("%{customdata.stat:,.", digits, "f}")

    # Use texttemplate (accesses customdata on all nodes including parents with
    # values=0) rather than textinfo+text (treemaps suppress text on value=0 nodes).
    # "prop" also needs texttemplate to display raw proportion (not percentage).
    use_template <- show_text && (
      (non_additive && !identical(labels, "off")) ||
      identical(labels, "prop")
    )

    txtinfo <- if (!show_text) "none"
               else switch(labels,
                 "input" = if (non_additive) "none" else "label+value",
                 "%"     = "label+percent root",
                 "prop"  = "none",   # handled by texttemplate below
                 "off"   = "label",  # label name only, no value/stat
                 "label"
               )

    texttemplate_str <- if (!use_template) NULL
      else if (non_additive && !identical(labels, "prop"))
        paste0("%{label}<br>", fmt_spec)                      # stat value
      else if (identical(labels, "prop"))
        "%{label}<br>%{percentRoot:.3f}"                      # raw proportion
      else
        NULL

    stat_line <- paste0(
      stat_label, ": %{customdata.stat:,.", digits, "f}"
    )

    pct_parent_line <- if (non_additive) ""
                       else "% of parent: %{percentParent:.2%}"

    hover_lines <- c(
      "%{customdata.meta}",
      stat_line,
      pct_parent_line,
      "% of total: %{percentRoot:.2%}"
    )

    hover <- paste(hover_lines[nzchar(hover_lines)], collapse = "<br>")
    hover <- paste0(hover, "<extra></extra>")

    # map top-level category -> color, then inherit down the tree
    col_map   <- setNames(as.character(fill_vec), top_levels)
    node_cols <- unname(col_map[as.character(nd$root)])
    node_cols[is.na(node_cols)] <- unname(col_map[1L])  # fallback if any NA

    n_nodes <- length(nd$ids)
    marker <- list(
      colors = node_cols,
      line   = list(
        color = I(rep(border_hex, n_nodes)),
        width = I(rep(1,          n_nodes))
      )
    )

    plt_out <- plotly::add_trace(
      p,
      type             = type,
      ids              = nd$ids,
      labels           = nd$labels,
      parents          = nd$parents,
      values           = nd$values,
      customdata       = nd$customdata,
      domain           = list(x = domain_xy$x, y = domain_xy$y),
      branchvalues     = "remainder",
      textinfo         = txtinfo,
      texttemplate     = texttemplate_str,
      textfont         = list(size = label_fsize, color = labels_color),
      hovertemplate    = hover,
      marker           = marker
    )
    plt_out
  }  # end make_trace()


  # ---- node builder function --------------------------------------------

  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)   # sizing values (always additive)
    out_text    <- character(0) # display text for non-additive stats
    out_custom  <- list()       # holds pretty meta + stat value
    out_root    <- character(0) # top-level category for color mapping

    for (lvl in seq_len(n_levels)) {
      cols <- path_cols[1:lvl]
      # ---- compute size + stat for this level (slice-by-slice) ----

      # sizing and stat: always use stat_fun so rectangle area reflects the
      # displayed statistic, consistent with pre-aggregated data behaviour
      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 category = value of first path column at this aggregated node
      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)
      }

      # human-readable meta lines
      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)

      # node counts (n), aligned to agg_size row order
      if (is.null(y.call)) {
        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)
      # branchvalues="remainder": only leaves carry values; parent value = 0
      # so Plotly sums children automatically — no parent/child mismatch possible
      out_values  <- c(out_values,
                       if (lvl == n_levels) agg_size$size else rep(0, nrow(agg_size)))
      # pre-format the stat value for display in nodes (used when non-additive)
      stat_vals <- agg_stat$stat
      digits    <- if (is.null(digits_d)) 2L else max(0L, as.integer(digits_d))
      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)
    }  # end: for (lvl in seq_len(n_levels))

    nd <- data.frame(
      ids     = out_ids,
      labels  = out_labels,
      parents = out_parents,
      values  = out_values,
      text    = out_text,
      root    = factor(out_root, levels = top_levels)
    )
    nd$customdata <- I(out_custom)
    nd  #return
  }  # end build_nodes()


# begin analysis ----------------------------------------------------------

  labels          <- match.arg(labels)
  labels_position <- match.arg(labels_position)

  # final flag that controls text on/off for nodes
  # "off" still shows label only — show_text stays TRUE for all label values
  show_text <- isTRUE(show_labels)

  # simple font scaling (same base as other lessR plotlys)
  base_font   <- 12
  label_fsize <- base_font * labels_size


# build path table ------------------------------------------------------------ 

  mk_char <- function(v) as.character(v)

  if (is.null(by.call)) {
    path_df   <- data.frame(x = mk_char(x.call), check.names=FALSE)
    lvl_names <- c(x.name)
  }
  else if (is.data.frame(by.call)) {
    tmp <- as.data.frame(lapply(by.call, mk_char), check.names=FALSE)
    path_df   <- data.frame(x = mk_char(x.call), tmp, check.names=FALSE)
    lvl_names <- c(x.name, names(tmp))
  }
  else {
    path_df   <- data.frame(x = mk_char(x.call), by = mk_char(by.call),
                            check.names=FALSE)
    lvl_names <- c(x.name, by.name %||% "by")
  }

  path_cols <- names(path_df)
  n_levels  <- length(path_cols)

  # ---- base numeric vector from y (or 1s for counts) -------------------
  base_vals <- if (is.null(y.call)) rep(1, nrow(path_df)) else {
    z <- suppressWarnings(as.numeric(y.call))
    z[!is.finite(z)] <- 0  # treat non-finite as 0 for sizing; ring must close
    z
  }

  # ---- set the stat function & label ------------------------------------
  STAT <- tolower(stat %||% "sum")
  stat_fun <- switch(
    STAT,
    mean   = function(z) mean(z, na.rm=TRUE),
    sum    = function(z) sum(z,  na.rm=TRUE),
    median = function(z) stats::median(z, na.rm=TRUE),
    min    = function(z) min(z, na.rm=TRUE),
    max    = function(z) max(z, na.rm=TRUE),
    sd     = function(z) stats::sd(z,  na.rm=TRUE),
    function(z) sum(z, na.rm=TRUE)
  )

  non_additive <- !identical(STAT, "sum")

  stat_label <- if (is.null(y.call)) "Count"
               else if (non_additive) paste0(toupper(substr(STAT,1,1)),
                                             substr(STAT,2,nchar(STAT)),
                                             " of ", y.name)
               else y.name

  # no subtitle needed — area always reflects the displayed statistic
  add_size_note <- function(ttl) ttl


# assign colors, setup based on top-level categories ----------------------

  # sequential palette names: light-to-dark; we want dark = large
  sequential_pals <- c("gray", "grays", "grey", "greys",
                        "blues", "greens", "reds", "purples",
                        "oranges", "browns", "terrain")
  pal_name <- tolower(fill_palette[1L] %||% "")
  is_sequential <- pal_name %in% sequential_pals ||
                   theme %in% c("gray", "white")

  # top-level categories are in the first path column
  top_raw <- mk_char(path_df[[1L]])
  # Exclude NA and unused factor levels to prevent fill_vec length mismatch
  top_levels_present <- unique(top_raw[!is.na(top_raw)])
  top_levels <- if (is.factor(x.call)) {
    fac_levs <- levels(x.call)
    fac_levs[fac_levs %in% top_levels_present]
  } else {
    top_levels_present
  }

  # for sequential palettes, compute top-level values and map proportionally
  # to color positions — reflects stat value (same as sizing)
  top_stats_ordered <- NULL
  if (is_sequential) {
    agg_fun <- if (!is.null(y.call)) stat_fun
               else function(z) sum(ifelse(is.na(z), 0, 1))  # counts when no y
    top_stats <- tapply(base_vals, mk_char(path_df[[1L]]), agg_fun)
    top_stats <- top_stats[top_levels]
    ord <- order(top_stats, decreasing = TRUE)
    top_levels <- top_levels[ord]
    top_stats_ordered <- top_stats[ord]
  }

  .prop_idx <- function(vals, n_pal, lo = 0.28, hi = 1.0) {
    # map vals proportionally into [lo, hi] fraction of palette
    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))
  }

  if (is.null(fill)) {
    if (is_sequential) {
      # generate a large palette then pick colours proportionally to stat magnitude
      n_lvl <- length(top_levels)
      big_pal <- .color_range("grays", 256L)
      if (!is.null(top_stats_ordered) && n_lvl > 1L) {
        idx      <- .prop_idx(top_stats_ordered, 256L)
        fill_vec <- big_pal[idx]
      } else {
        fill_vec <- big_pal[.prop_idx(seq_len(n_lvl), 256L)]
      }
    } else {
      base_cols <- .plotly_base_colors()
      fill_vec  <- rep_len(base_cols, length(top_levels))
    }
  }
  else {
    # fill arrives as a pre-expanded hex vector from Chart.R
    n_lvl   <- length(top_levels)
    big_pal <- fill[seq_len(length(fill))]  # full palette light→dark
    if (is_sequential && !is.null(top_stats_ordered) && n_lvl > 1L) {
      idx      <- .prop_idx(top_stats_ordered, length(big_pal))
      fill_vec <- big_pal[idx]
    } else if (is_sequential) {
      fill_vec <- big_pal[.prop_idx(seq_len(n_lvl), length(big_pal))]
    } else {
      fill_vec <- fill[seq_len(n_lvl)]
      if (length(fill_vec) < n_lvl) fill_vec <- rep_len(fill_vec, n_lvl)
    }
  }

  # border color, one color for all nodes; consistent with prior behavior
  border_hex <- .to_hex(if (is.null(border)) "white" else border[1L])


# start plot & set base colorway (still used by Plotly defaults) ----------

  p <- plotly::plot_ly()
  p <- plotly::layout(p, colorway = fill_vec)

title_x <- if (is.null(title_x)) {
  if (identical(type, "icicle")) {
    if (!is.null(facet.call)) 0.50
    else if (!is.null(by.call)) 0.64
    else 0.71
  }
  else 0.50
} else {
  as.numeric(title_x)
}


# -------------------------------------------------------------------------
# non-faceted -------------------------------------------------------------

  if (is.null(facet.call)) {
    nd <- build_nodes(seq_len(nrow(path_df)), facet_label = NULL)
    p  <- make_trace(p, nd, list(x = c(0, 1), y = c(0, 1)))

    ttl_text <- add_size_note(main %||% .plotly_build_title(
      x.name, by.name, facet.name = NULL,
      y.name = if (is.null(y.call)) NULL else y.name,
      stat   = if (is.null(y.call)) NULL else STAT
    ))

    # For treemaps, plotly's built-in title expands the top margin based on
    # label font size, squeezing the chart unpredictably. Instead, use an
    # annotation positioned in paper coordinates — full control, no side effects.
    if (type %in% c("treemap", "icicle") && !is.null(ttl_text)) {
      # two-line titles (non_additive with y) need more top space
      has_sub <- grepl("<br>", ttl_text, fixed = TRUE)
      t_px    <- if (has_sub) 44 else 38

      # single annotation with yanchor="bottom" keeps both lines above y=1,
      # entirely in the top margin — never overlaps the treemap "All" rectangle.
      if (has_sub) {
        parts    <- strsplit(ttl_text, "<br>", fixed = TRUE)[[1]]
        ttl_text <- paste0(
          "<span style=\"font-size:16px\">", parts[1], "</span>",
          "<br>",
          "<span style=\"font-size:13px\">", parts[2], "</span>"
        )
      }
      title_anns <- list(list(
        text      = ttl_text,
        x        =title_x, xref="paper", xanchor="center",
        y        =1,       yref="paper", yanchor="bottom",
        showarrow=FALSE,
        font     =list(size=16)
      ))

      p <- plotly::layout(p,
        margin     =list(t=t_px, b=8, l=20, r=20),
        annotations = title_anns
      )
    } else {
      p <- plotly::layout(
        p,
        margin = list(
          t = 35,
          b = 8,
          l = 20,
          r = if (identical(type, "icicle")) 30 else 20
        ),
        title = list(
          text = ttl_text,
          font = list(size = 16),
          x = title_x,
          xanchor = "center",
          y = if (is.null(y.call)) 0.97 else 1.00,
          yanchor = "top"
        )
      )
    }

    # Ensure unique htmlwidget id (REQUIRED for knitting)
    if (is.null(p$elementId)) {
      p$elementId <- paste0(
        "lessr-hier-",
        format(Sys.time(), "%Y%m%d%H%M%OS3"),
        "-",
        sample.int(1e5, 1)
      )
    }

    return(p)
  }



# -------------------------------------------------------------------------
# faceted -----------------------------------------------------------------

  # when facet.call is a data frame (multiple facet vars), collapse to
  # interaction labels so each unique combination gets its own panel
  if (is.data.frame(facet.call)) {
    facet.call <- apply(facet.call, 1, paste, collapse = "/")
    facet.call <- factor(facet.call, levels = unique(facet.call))
  }

  fac_levels <- if (!is.null(levels(facet.call))) levels(facet.call)
                else unique(mk_char(facet.call))

  # sort levels so panels appear in consistent order (M/1, M/2, M/3, W/1 ...)
  fac_levels <- sort(fac_levels)
  facet.call <- factor(mk_char(facet.call), levels = fac_levels)

  n_fac <- length(fac_levels)

  gx <- max(0, as.numeric(facet_gap_x)) *
        (1 / max(1e-9, as.numeric(facet_size)))
  gy <- max(0, as.numeric(facet_gap_y)) *
        (1 / max(1e-9, as.numeric(facet_size)))

  grid    <- .plotly_make_domains_grid(
    n_fac    = n_fac,
    n_col_max = 3L,
    gap_x    = gx,
    gap_y    = gy
  )
  domains <- grid$domains


# type-specific vertical adjustments for facets ---------------------------

  # for titles and reduce overlap with the main title.
  if (type == "treemap") {
    domains <- lapply(domains, function(d) {
      y0   <- d$y[1]; y1 <- d$y[2]
      span <- y1 - y0
      shift <- 0.06  # increased from 0.04 to give more room above panel
      new_y0 <- max(0, y0 - shift)
      new_y1 <- new_y0 + span
      if (new_y1 > 1) {
        new_y1 <- 1
        new_y0 <- new_y1 - span
      }
      list(x = d$x, y = c(new_y0, new_y1))
    })
  }
  else if (type == "icicle") {
    domains <- lapply(domains, function(d) {
      y0   <- d$y[1]; y1 <- d$y[2]
      span <- y1 - y0 * (1.12)  # lengthen vertical span a bit
      new_y1 <- max(0, y1 - 0.10)  # move down to create top space
      new_y0 <- max(0, new_y1 - span)
      if (new_y1 > 1) {
        new_y1 <- 1
        new_y0 <- new_y1 - span
      }
      list(x = d$x, y = c(new_y0, new_y1))
    })
  }
  else if (type == "sunburst") {
    # For faceted sunbursts, drop the panels slightly downward
    # to create more space between facet titles and the rings
    shift <- 0.06  # about 6% of full figure height

    domains <- lapply(domains, function(d) {
      y0   <- d$y[1]; y1 <- d$y[2]
      span <- (y1 - y0)

      new_y1 <- min(1, y1 - shift)
      new_y0 <- max(0, new_y1 - span)

      list(x = d$x, y = c(new_y0, new_y1))
    })
  }


# add traces for each facet -----------------------------------------------

  for (i in seq_along(fac_levels)) {
    fac_lab <- fac_levels[i]
    idx     <- which(mk_char(facet.call) == fac_lab)
    nd      <- build_nodes(idx, facet_label = fac_lab)

    # for sequential palettes, recompute fill_vec from this facet's data
    # so luminance spans the full range independently within each panel
    if (is_sequential && nrow(nd) > 0L) {
      fac_base  <- base_vals[idx]
      fac_x     <- mk_char(path_df[[1L]])[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]
      n_fac_top <- length(fac_top)
      if (n_fac_top > 1L) {
        idx_f    <- .prop_idx(fac_stats, length(big_pal))
        fill_vec <- setNames(big_pal[idx_f], fac_top)
      } else {
        fill_vec <- setNames(big_pal[.prop_idx(1L, length(big_pal))], fac_top)
      }
    }

    # treemap lays out rows bottom-to-top; reverse domain assignment so
    # sorted fac_levels appear top-left to bottom-right visually
    dom_i <- if (type == "treemap") (n_fac + 1L - i) else i
    if (nrow(nd) > 0L)
      p <- make_trace(p, nd, domains[[dom_i]])
  }

  ttl_text <- add_size_note(main %||% .plotly_build_title(
    x.name, by.name, facet.name,
    y.name = if (is.null(y.call)) NULL else y.name,
    stat   = if (is.null(y.call)) NULL else STAT
  ))

  # if two-line title, render subtitle smaller than main line
  if (grepl("<br>", ttl_text, fixed = TRUE)) {
    parts    <- strsplit(ttl_text, "<br>", fixed = TRUE)[[1]]
    ttl_text <- paste0(
      "<span style=\"font-size:16px\">", parts[1], "</span>",
      "<br>",
      "<span style=\"font-size:13px\">", parts[2], "</span>"
    )
  }


# facet title annotations -------------------------------------------------

  ann <- .plotly_facet_annotations(
    domains,
    facet_levels = fac_levels,
    facet_name   = facet.name,
    y_base       = facet_title_y_base,
    y_row_shift  = facet_title_row_shift
  )

  if (type %in% c("sunburst", "treemap")) {
    for (i in seq_along(ann)) {
      dom_i_ann <- if (type == "treemap") (n_fac + 1L - i) else i
      top_y <- domains[[dom_i_ann]]$y[2]
      ann[[i]]$x       <- (domains[[dom_i_ann]]$x[1] + domains[[dom_i_ann]]$x[2]) / 2
      ann[[i]]$y       <- min(top_y - 0.025, 0.99)
      ann[[i]]$yanchor <- "bottom"
    }
  } else if (type == "icicle") {
    for (i in seq_along(ann)) {
      top_y <- domains[[i]]$y[2]
      ann[[i]]$yref    <- "paper"
      ann[[i]]$yanchor <- "bottom"
      ann[[i]]$y       <- min(top_y + 0.02, 0.99)
      ann[[i]]$xanchor <- "right"
      ann[[i]]$x       <- ann[[i]]$x + 0.10
    }
  }


  # Plot --------------------------------------------------------------------

  t_margin <- 50

  p <- plotly::layout(
    p,
    annotations = ann,
    margin = list(
      t = if (identical(type, "treemap")) t_margin - 5 else t_margin,
      b = 8,
      l = if (identical(type, "icicle")) 0.00 else 10,
      r = if (identical(type, "icicle")) 30 else 20
    ),
    title = list(
      text = ttl_text,
      font = list(size = 16),
      x = if (identical(type, "icicle")) 0.55 else title_x,
      xanchor = "center"
    )
  )

  # plotly auto-expands the top margin based on trace label font sizes —
  # lock it back to the intended value after layout is built
  if (!is.null(p$x$layout$margin))
    p$x$layout$margin$t <- t_margin

  p$elementId <- paste0(
    "lessr-hier-",
    format(Sys.time(), "%Y%m%d%H%M%OS3"),
    "-",
    sample.int(1e5, 1)
  )

  p   # last expression returned
}
