# -------------------------------------------------------------------
# merge_tables internals
# -------------------------------------------------------------------

#' @keywords internal
#' @noRd
.theme_presets_merge <- list(
  minimal  = c("plain", "lines", "labels_bold"),
  clinical = c("plain", "labels_bold", "compact"),
  striped  = c("zebra", "labels_bold", "compact"),
  shaded   = c("header_shaded", "labels_bold", "lines"),
  jama     = c("plain", "lines", "labels_bold", "compact")
)

#' @keywords internal
#' @noRd
.resolve_theme_merge <- function(theme) {
  if (length(theme) == 1 && !is.na(theme) &&
      theme %in% names(.theme_presets_merge)) {
    return(.theme_presets_merge[[theme]])
  }
  unique(tolower(theme))
}

#' Build canonical row-id map for a table_display object
#'
#' Rules:
#' - every header row is retained
#' - header followed immediately by another header (or end of table) is treated
#'   as a continuous/main-effect row and gets id var||var
#' - categorical headers get id var||__header__
#' - non-header rows get id current_var||level
#'
#' @keywords internal
#' @noRd
.canonical_row_ids <- function(obj, df) {
  body <- obj[["table_body"]]

  if (is.data.frame(body) && all(c("var", "level", "type") %in% names(body))) {
    ids <- character()
    for (v in unique(body$var)) {
      rows <- body[body$var == v, , drop = FALSE]
      data_rows <- rows[rows$type != "header", , drop = FALSE]

      if (!nrow(data_rows)) {
        ids <- c(ids, paste0(v, "||", v))
      } else if (all(data_rows$type == "continuous")) {
        ids <- c(ids, paste0(v, "||", v))
      } else if (any(data_rows$type == "dichotomous")) {
        ids <- c(ids, paste0(v, "||", data_rows$level))
      } else {
        ids <- c(
          ids,
          paste0(v, "||__header__"),
          paste0(v, "||", data_rows$level)
        )
      }
    }
    if (length(ids) == nrow(df)) {
      return(ids)
    }
  }

  if (is.data.frame(body) && all(c("exposure", "level", "ref") %in% names(body))) {
    ids <- character()
    for (v in unique(body$exposure)) {
      rows <- body[body$exposure == v, , drop = FALSE]
      is_fact <- any(rows$ref %in% TRUE)

      if (!is_fact && nrow(rows) == 1L) {
        ids <- c(ids, paste0(v, "||", v))
      } else {
        levels <- rows$level
        if (!is_fact) {
          levels <- levels[levels != v]
        }
        ids <- c(
          ids,
          paste0(v, "||__header__"),
          paste0(v, "||", levels)
        )
      }
    }
    if (length(ids) == nrow(df)) {
      return(ids)
    }
  }

  NULL
}

.canonical_map <- function(obj) {
  df <- if (is.list(obj) && !is.null(obj[["table_display"]])) {
    obj[["table_display"]]
  } else {
    obj
  }
  stopifnot(all(c("Characteristic", "is_header") %in% names(df)))

  ids <- .canonical_row_ids(obj, df)

  if (is.null(ids)) {
    ids <- rep(NA_character_, nrow(df))
    current_var <- NA_character_

    for (i in seq_len(nrow(df))) {
      ch <- trimws(df$Characteristic[i])
      ih <- isTRUE(df$is_header[i])

      if (ih) {
        current_var <- ch

        # Continuous/main-effect rows live on the header line; categorical
        # headers are structural rows and should still be preserved.
        if (i == nrow(df) || isTRUE(df$is_header[i + 1])) {
          ids[i] <- paste0(current_var, "||", current_var)
        } else {
          ids[i] <- paste0(current_var, "||__header__")
        }
      } else {
        lvl <- trimws(df$Characteristic[i])
        lvl <- sub("\\s*\\((Ref\\.|ref)\\)$", "", lvl)
        ids[i] <- paste0(current_var, "||", lvl)
      }
    }
  }

  content_cols <- setdiff(names(df), c("Characteristic", "is_header"))
  if ("N" %in% content_cols) {
    content_cols <- c("N", setdiff(content_cols, "N"))
  }

  lookup <- new.env(parent = emptyenv())
  for (i in which(!is.na(ids))) {
    lookup[[ids[i]]] <- df[i, content_cols, drop = FALSE]
  }

  labels <- stats::setNames(as.character(df$Characteristic), ids)
  headers <- stats::setNames(as.logical(df$is_header), ids)

  list(
    row_ids_order = ids,
    content_cols = content_cols,
    lookup = lookup,
    labels = labels,
    headers = headers
  )
}

#' Align compact binary regression rows to descriptive level rows
#'
#' Regression tables that do not display reference rows may represent a binary
#' exposure as one compact row (var||var). When merged with a descriptive table
#' that has explicit level rows (var||No, var||Yes), the compact row should live
#' on the non-reference level rather than creating a separate variable row.
#'
#' @keywords internal
#' @noRd
.align_compact_binary_maps <- function(maps) {
  parse_ids <- function(ids) {
    parts <- strsplit(ids, "\\|\\|")
    data.frame(
      id = ids,
      var = vapply(parts, `[`, character(1), 1),
      level = vapply(parts, `[`, character(1), 2),
      stringsAsFactors = FALSE
    )
  }

  all_ids <- unique(unlist(lapply(maps, `[[`, "row_ids_order"), use.names = FALSE))
  all_ids <- all_ids[!is.na(all_ids)]
  id_df <- parse_ids(all_ids)

  positive_values <- c(
    "yes", "y", "true", "1", "present", "positive", "exposed",
    "case", "event"
  )

  choose_level <- function(var, current_label) {
    candidates <- id_df$level[
      id_df$var == var &
        !id_df$level %in% c(var, "__header__")
    ]
    candidates <- unique(candidates[nzchar(candidates)])
    if (!length(candidates)) {
      return(NA_character_)
    }

    current_label <- trimws(current_label)
    label_match <- candidates[tolower(candidates) == tolower(current_label)]
    if (length(label_match)) {
      return(label_match[1])
    }

    positive_match <- candidates[tolower(candidates) %in% positive_values]
    if (length(positive_match)) {
      return(positive_match[1])
    }

    if (length(candidates) == 2L) {
      return(candidates[2])
    }

    NA_character_
  }

  remapped <- character()

  for (m in seq_along(maps)) {
    ids <- maps[[m]]$row_ids_order
    if (!length(ids)) {
      next
    }

    parsed <- parse_ids(ids)
    compact <- which(parsed$var == parsed$level)

    for (i in compact) {
      from <- parsed$id[i]
      value <- maps[[m]]$lookup[[from]]
      if (is.null(value)) {
        next
      }

      label <- unname(maps[[m]]$labels[from])
      target_level <- choose_level(parsed$var[i], label)
      if (is.na(target_level)) {
        next
      }

      to <- paste0(parsed$var[i], "||", target_level)
      if (identical(from, to)) {
        next
      }

      maps[[m]]$lookup[[to]] <- value
      rm(list = from, envir = maps[[m]]$lookup)

      maps[[m]]$row_ids_order[maps[[m]]$row_ids_order == from] <- to
      names(maps[[m]]$labels)[names(maps[[m]]$labels) == from] <- to
      if (!is.null(maps[[m]]$headers)) {
        names(maps[[m]]$headers)[names(maps[[m]]$headers) == from] <- to
        maps[[m]]$headers[to] <- FALSE
      }
      remapped <- c(remapped, parsed$var[i])
    }
  }

  list(
    maps = maps,
    remapped = unique(remapped)
  )
}

#' Inspect binary row representations across tables before merging.
#'
#' - `compact` indicates the variable is represented by one row (for example
#'   `smoke` as a single row in regression output with reference rows hidden).
#' - `expanded` indicates the variable is represented with explicit levels,
#'   e.g. `smoke = No`, `smoke = Yes`.
#'
#' @keywords internal
#' @noRd
.binary_mode_profile <- function(tbl) {
  body <- tbl[["table_body"]]
  display <- tbl[["table_display"]]
  if (!is.data.frame(body) || !nrow(body)) {
    return(list(compact = character(), expanded = character()))
  }
  body <- as.data.frame(body, stringsAsFactors = FALSE)
  if (is.data.frame(display)) {
    display <- as.data.frame(display, stringsAsFactors = FALSE)
  }

  compact <- character()
  expanded <- character()

  if (all(c("var", "type", "level") %in% names(body))) {
    for (v in unique(body$var)) {
      rows <- body[which(body$var == v), , drop = FALSE]
      data_rows <- rows[which(rows$type != "header"), , drop = FALSE]

      if (any(data_rows$type %in% "dichotomous")) {
        compact <- c(compact, v)
        next
      }

      level_rows <- data_rows[
        which(data_rows$type %in% c(
          "categorical", "dichotomous", "categorical_missing"
        )),
        ,
        drop = FALSE
      ]
      if (nrow(level_rows) == 0L) {
        next
      }

      level_vals <- trimws(as.character(level_rows$level))
      level_vals <- level_vals[nzchar(level_vals)]
      if (length(level_vals) %in% c(2L, 3L)) {
        # Two levels for all-level binary, or two levels + (Missing).
        expanded <- c(expanded, v)
      }
    }
    return(list(compact = unique(compact), expanded = unique(expanded)))
  }

  if (all(c("exposure", "level", "ref") %in% names(body))) {
    for (v in unique(body$exposure)) {
      rows <- body[which(body$exposure == v), , drop = FALSE]
      is_factor <- any(rows$ref %in% TRUE)

      if (is_factor && is.data.frame(display) &&
          all(c("Characteristic", "is_header") %in% names(display))) {
        header <- which(
          display$is_header %in% TRUE &
            trimws(as.character(display$Characteristic)) == v
        )
        if (length(header) == 1L) {
          next_header <- which(
            display$is_header %in% TRUE & seq_len(nrow(display)) > header
          )
          last_row <- if (length(next_header)) {
            next_header[1L] - 1L
          } else {
            nrow(display)
          }
          visible_levels <- if (header < last_row) {
            sum(!display$is_header[(header + 1L):last_row])
          } else {
            0L
          }

          # `show_ref = FALSE` represents a binary predictor on its header row.
          if (visible_levels == 0L && nrow(rows) == 2L) {
            compact <- c(compact, v)
          } else {
            expanded <- c(expanded, v)
          }
          next
        }
      }

      if (nrow(rows) == 1L) {
        # Regression compact binary row usually has level different from variable
        # name because reference rows are removed.
        lev <- as.character(rows$level[[1]])
        if (!identical(trimws(lev), trimws(v))) {
          compact <- c(compact, v)
        }
      } else if (is_factor && any(!rows$ref %in% TRUE)) {
        expanded <- c(expanded, v)
      }
    }
  }

  list(compact = unique(compact), expanded = unique(expanded))
}

#' Warn when binary rows are mixed as compact versus expanded across inputs.
#'
#' @keywords internal
#' @noRd
.binary_merge_mismatch <- function(tbls) {
  profiles <- lapply(tbls, .binary_mode_profile)

  compact_vars <- list()
  expanded_vars <- list()

  for (i in seq_along(profiles)) {
    profile <- profiles[[i]]

    for (v in profile$compact) {
      previous <- compact_vars[[v]]
      if (is.null(previous)) {
        previous <- integer()
      }
      compact_vars[[v]] <- unique(c(previous, i))
    }

    for (v in profile$expanded) {
      previous <- expanded_vars[[v]]
      if (is.null(previous)) {
        previous <- integer()
      }
      expanded_vars[[v]] <- unique(c(previous, i))
    }
  }

  vars_compact <- names(compact_vars)
  vars_expanded <- names(expanded_vars)
  mismatch <- intersect(vars_compact, vars_expanded)

  unique(mismatch)
}

#' Warn when binary rows are mixed as compact versus expanded across inputs.
#'
#' @keywords internal
#' @noRd
.warn_binary_merge_mode <- function(tbls) {
  mismatch <- .binary_merge_mismatch(tbls)

  if (!length(mismatch)) return(invisible(NULL))

  warning(
    "merge_tables(): binary display mode mismatch for variable(s): ",
    paste(mismatch, collapse = ", "),
    ". When merging descriptive, univariable, and multivariable tables, use ",
    "`show_dichotomous = \"all_levels\"` in descriptive_table() and ",
    "`show_ref = TRUE` in every regression table to prevent extra binary rows. ",
    "Alternatively, use compact display consistently: `show_dichotomous = ",
    "\"single_row\"` and `show_ref = FALSE`.",
    call. = FALSE
  )
}

#' Build merged skeleton using the union of canonical row ids
#' across all input tables
#' @keywords internal
#' @noRd
.build_merged_skeleton <- function(maps) {
  all_ids <- unique(unlist(
    lapply(maps, `[[`, "row_ids_order"),
    use.names = FALSE
  ))
  all_ids <- all_ids[!is.na(all_ids)]

  rows <- lapply(all_ids, function(id) {
    parts <- strsplit(id, "\\|\\|")[[1]]
    var <- parts[1]
    lvl <- parts[2]

    is_source_header <- any(vapply(
      maps,
      function(map) {
        if (is.null(map$headers)) {
          return(FALSE)
        }
        isTRUE(unname(map$headers[id]))
      },
      logical(1)
    ))
    is_header <- identical(var, lvl) || identical(lvl, "__header__") ||
      is_source_header
    label <- NA_character_
    for (map in maps) {
      hit <- unname(map$labels[id])
      if (!is.na(hit) && nzchar(hit)) {
        label <- hit
        break
      }
    }
    char <- if (!is.na(label)) label else if (is_header) var else paste0("  ", lvl)

    data.frame(
      Characteristic = char,
      is_header = is_header,
      row_id = id,
      stringsAsFactors = FALSE
    )
  })

  do.call(rbind, rows)
}

#' Collect footnotes from gtregression objects
#' @keywords internal
#' @noRd
.collect_footnotes <- function(obj) {
  # Prefer the notes created by the source function. A merge must preserve the
  # source table's reporting decisions rather than recreate them.
  stored_footnotes <- obj[["footnotes"]]
  if (!is.null(stored_footnotes)) {
    stored_footnotes <- as.character(stored_footnotes)
    return(unique(stored_footnotes[nzchar(stored_footnotes)]))
  }

  # Compatibility fallback for objects created by earlier gtregression
  # versions that did not retain their rendered notes.
  out <- character()

  approach <- obj[["approach"]]
  if (!is.null(approach) && exists(".abbrev_note", mode = "function")) {
    out <- c(out, .abbrev_note(approach))
  }

  adjust_for <- obj[["adjust_for"]]
  if (!is.null(adjust_for) && length(adjust_for) &&
      exists(".adjustment_note", mode = "function")) {
    out <- c(out, .adjustment_note(adjust_for))
  }

  models <- obj[["models"]]
  is_single_multi <- inherits(obj, "multi_reg") &&
    !is.null(models) &&
    length(models) == 1L &&
    !is.null(models[[1]])

  if (is_single_multi) {
    n_used <- tryCatch(
      stats::nobs(models[[1]]),
      error = function(e) NA_integer_
    )
    if (!is.na(n_used)) {
      out <- c(
        out,
        paste0(
          "N = ", n_used,
          " complete observations included in the model."
        )
      )
    }
  }

  unique(out[nzchar(out)])
}

# -------------------------------------------------------------------
# merge_tables main
# -------------------------------------------------------------------

#' Merge gtregression tables and preserve structure and notes
#'
#' @param ... Two or more \code{gtregression} objects containing
#'   \code{$table_display}.
#' @param spanners Character vector of spanner labels, one per table.
#'   If \code{NULL}, defaults to \code{"Table 1"}, \code{"Table 2"}, etc.
#' @param theme Merge theme preset or vector of primitives.
#' @param format Output table format. One of \code{"flextable"} (default) or
#'   \code{"gt"}. The merged display is rebuilt in this format, independently
#'   of the formats used by the input tables.
#' @details
#' Binary variables should use the same row display across all input tables.
#' For a descriptive, univariable, and multivariable merge, the clearest
#' publication layout is usually \code{show_dichotomous = "all_levels"} in
#' \code{descriptive_table()} and \code{show_ref = TRUE} in each regression
#' function. Mixing these settings can create additional binary rows; in that
#' situation \code{merge_tables()} issues a warning with the compatible
#' settings.
#'
#' Footnotes created by each input table are retained unchanged. Exact duplicate
#' notes are shown once in the merged table.
#'
#' @return A merged table object of class
#'   \code{c("gtregression", "merged_table", ...)}.
#'
#' @examples
#' birthwt_data <- data_birthwt |>
#'   dplyr::mutate(
#'     race = factor(race, levels = c(1, 2, 3),
#'                   labels = c("White", "Black", "Other")),
#'     smoke = factor(smoke, levels = c(0, 1), labels = c("No", "Yes")),
#'     ht = factor(ht, levels = c(0, 1), labels = c("No", "Yes")),
#'     low = factor(low, levels = c(0, 1), labels = c("Normal BW", "Low BW"))
#'   )
#'
#' uni_tbl <- uni_reg(
#'   data = birthwt_data,
#'   outcome = "low",
#'   exposures = c("age", "lwt", "smoke", "ht"),
#'   approach = "logit"
#' )
#'
#' multi_tbl <- multi_reg(
#'   data = birthwt_data,
#'   outcome = "low",
#'   exposures = c("smoke", "ht"),
#'   adjust_for = c("age", "lwt"),
#'   approach = "logit"
#' )
#'
#' merge_tables(
#'   uni_tbl,
#'   multi_tbl,
#'   spanners = c("Univariable", "Adjusted")
#' )
#' @export
merge_tables <- function(...,
                         spanners = NULL,
                         theme = "minimal",
                         format = c("flextable", "gt")) {
  theme <- .choice_arg(substitute(theme), env = parent.frame())
  format <- .choice_arg(
    substitute(format),
    env = parent.frame(),
    choices = c("flextable", "gt")
  )
  format <- match.arg(format, c("flextable", "gt"))

  tbls <- list(...)

  if (length(tbls) < 2L) {
    stop("Provide at least two tables to merge.", call. = FALSE)
  }

  ok <- vapply(
    tbls,
    function(x) inherits(x, "gtregression") && !is.null(x[["table_display"]]),
    logical(1)
  )
  if (!all(ok)) {
    stop(
      "All inputs must be outputs of this package (contain $table_display).",
      call. = FALSE
    )
  }

  engines <- vapply(
    tbls,
    function(x) {
      fmt <- x[["format"]]
      tbl <- x[["table"]]

      if (!is.null(fmt)) {
        return(tolower(fmt))
      }
      if (inherits(tbl, "gt_tbl")) {
        return("gt")
      }
      if (inherits(tbl, "flextable")) {
        return("flextable")
      }
      NA_character_
    },
    character(1)
  )

  if (anyNA(engines) || length(unique(engines)) != 1L) {
    stop(
      "All inputs must use the same engine ('gt' or 'flextable').",
      call. = FALSE
    )
  }

  engine <- format
  theme <- .resolve_theme_merge(theme)

  if (is.null(spanners)) {
    spanners <- paste("Table", seq_along(tbls))
  }
  if (length(spanners) != length(tbls)) {
    stop("Length of `spanners` must equal number of tables.", call. = FALSE)
  }

  .warn_binary_merge_mode(tbls)
  binary_mismatch <- .binary_merge_mismatch(tbls)

  maps <- lapply(tbls, .canonical_map)
  aligned <- .align_compact_binary_maps(maps)
  maps <- aligned$maps
  aligned_mismatch <- intersect(aligned$remapped, binary_mismatch)
  if (length(aligned_mismatch)) {
    message(
      "merge_tables(): compact binary regression rows were aligned to ",
      "descriptive level rows for ",
      paste(aligned_mismatch, collapse = ", "),
      ". To display Ref., use `show_ref = TRUE` in the regression ",
      "function before merging."
    )
  }
  skeleton <- .build_merged_skeleton(maps)
  base_ids <- skeleton$row_id

  merged_cols <- list()
  col_labels <- list()

  for (i in seq_along(tbls)) {
    mi <- maps[[i]]

    blank_row <- as.data.frame(
      as.list(rep("", length(mi$content_cols))),
      stringsAsFactors = FALSE
    )
    names(blank_row) <- mi$content_cols

    aligned <- do.call(
      rbind,
      lapply(seq_along(base_ids), function(r) {
        rid <- base_ids[r]
        got <- mi$lookup[[rid]]
        if (is.null(got)) {
          blank_row
        } else {
          got[, mi$content_cols, drop = FALSE]
        }
      })
    )

    safe_names <- make.unique(
      paste0(make.names(mi$content_cols, unique = FALSE), "_p", i)
    )
    names(aligned) <- safe_names
    merged_cols[[i]] <- aligned
    col_labels[[i]] <- setNames(mi$content_cols, nm = safe_names)
  }

  merged_display <- cbind(
    skeleton[, c("Characteristic", "is_header"), drop = FALSE],
    do.call(cbind, merged_cols)
  )

  footnotes <- unique(unlist(
    lapply(tbls, .collect_footnotes),
    use.names = FALSE
  ))
  footnotes <- footnotes[nzchar(footnotes)]

  # ---------------- gt rendering ----------------

  apply_theme_gt <- function(tb, df, theme) {
    tb <- gt::tab_style(
      tb,
      gt::cell_text(weight = "bold"),
      locations = gt::cells_column_labels()
    )

    tb <- gt::tab_style(
      tb,
      gt::cell_text(weight = "bold"),
      gt::cells_body(rows = df$is_header %in% TRUE, columns = "Characteristic")
    )

    tb <- gt::tab_style(
      tb,
      gt::cell_text(indent = gt::px(12)),
      gt::cells_body(rows = df$is_header %in% FALSE, columns = "Characteristic")
    )

    if ("header_shaded" %in% theme) {
      tb <- gt::tab_options(
        tb,
        column_labels.background.color = "#f6f8fa"
      )
    }

    if ("zebra" %in% theme) {
      tb <- gt::opt_row_striping(tb)
    }

    if ("lines" %in% theme) {
      tb <- gt::tab_style(
        tb,
        gt::cell_borders(
          sides = "top",
          color = "#DADADA",
          weight = gt::px(1)
        ),
        gt::cells_body(rows = TRUE)
      )

      tb <- gt::tab_options(
        tb,
        table.border.top.style = "solid",
        table.border.top.color = "#DADADA",
        table.border.bottom.style = "solid",
        table.border.bottom.color = "#DADADA"
      )
    }

    if ("compact" %in% theme) {
      tb <- gt::tab_options(tb, data_row.padding = gt::px(2))
    }

    tb
  }

  build_gt_merge <- function(df, spanners, col_labels, theme, footnotes) {
    stopifnot(requireNamespace("gt", quietly = TRUE))

    content_cols <- unlist(lapply(col_labels, names), use.names = FALSE)
    out <- df[, c("Characteristic", content_cols), drop = FALSE]

    labels_list <- c(
      list(Characteristic = "Characteristic"),
      setNames(
        as.list(unlist(col_labels, use.names = FALSE)),
        nm = unlist(lapply(col_labels, names), use.names = FALSE)
      )
    )

    tb <- gt::gt(out) |>
      gt::cols_label(.list = labels_list) |>
      gt::cols_align("left", columns = "Characteristic") |>
      gt::cols_align(
        "center",
        columns = setdiff(names(out), "Characteristic")
      ) |>
      gt::sub_missing(
        columns = setdiff(names(out), "Characteristic"),
        missing_text = ""
      ) |>
      gt::tab_options(
        table.font.names = "system-ui",
        data_row.padding = gt::px(4),
        heading.background.color = "white",
        table.background.color = "white"
      )

    start <- 2L
    for (i in seq_along(spanners)) {
      k <- length(col_labels[[i]])
      if (k > 0) {
        tb <- gt::tab_spanner(
          tb,
          label = spanners[i],
          columns = names(out)[start:(start + k - 1L)]
        )
        start <- start + k
      }
    }

    tb <- gt::tab_style(
      tb,
      gt::cell_text(weight = "bold"),
      locations = gt::cells_column_spanners()
    )

    tb <- apply_theme_gt(tb, df, theme)

    if (length(footnotes)) {
      for (ln in footnotes) {
        tb <- gt::tab_source_note(tb, source_note = ln)
      }
      tb <- gt::tab_options(tb, source_notes.padding = gt::px(2))
    }

    tb
  }

  # ---------------- flextable rendering ----------------

  build_flex_merge <- function(df, spanners, col_labels, theme, footnotes) {
    stopifnot(requireNamespace("flextable", quietly = TRUE))

    content_cols <- unlist(lapply(col_labels, names), use.names = FALSE)
    out <- df[, c("Characteristic", content_cols), drop = FALSE]
    suppressWarnings(out[is.na(out)] <- "")

    keys <- colnames(out)
    labs <- c("Characteristic", unlist(col_labels, use.names = FALSE))

    ft <- flextable::flextable(out)
    ft <- flextable::set_header_labels(ft, values = stats::setNames(labs, keys))
    ft <- flextable::align(ft, j = "Characteristic", align = "left", part = "all")
    ft <- flextable::align(
      ft,
      j = setdiff(keys, "Characteristic"),
      align = "center",
      part = "all"
    )
    ft <- flextable::bold(ft, part = "header", bold = TRUE)

    widths <- c(1, vapply(col_labels, length, integer(1)))
    ft <- flextable::add_header_row(
      ft,
      values = c("", spanners),
      colwidths = widths
    )
    ft <- flextable::bold(ft, part = "header", bold = TRUE)

    hdr_idx <- which(df$is_header %in% TRUE)
    lvl_idx <- which(df$is_header %in% FALSE)

    if (length(hdr_idx)) {
      ft <- flextable::bold(
        ft,
        i = hdr_idx,
        j = "Characteristic",
        bold = TRUE,
        part = "body"
      )
    }

    if (length(lvl_idx)) {
      ft <- flextable::padding(
        ft,
        i = lvl_idx,
        j = "Characteristic",
        padding.left = 14,
        part = "body"
      )
    }

    if ("header_shaded" %in% theme) {
      ft <- flextable::bg(ft, part = "header", bg = "#f6f8fa")
    }

    if ("zebra" %in% theme && length(lvl_idx)) {
      ft <- flextable::bg(
        ft,
        i = lvl_idx[seq(1, length(lvl_idx), by = 2)],
        bg = "#f6f8fa",
        part = "body"
      )
    }

    if ("lines" %in% theme) {
      n_body <- nrow(out)
      if (!is.null(n_body) && n_body > 0) {
        ft <- flextable::hline(ft, i = 1, part = "body")
        ft <- flextable::hline(ft, i = n_body, part = "body")
      }
    }

    if ("compact" %in% theme) {
      ft <- flextable::padding(ft, padding = 2, part = "body")
    }

    ft <- flextable::autofit(ft)

    if (length(footnotes)) {
      ft <- flextable::add_footer_lines(ft, values = footnotes)
      ft <- flextable::align(ft, part = "footer", align = "left")
      ft <- flextable::padding(
        ft,
        part = "footer",
        padding.top = 0,
        padding.bottom = 0
      )
      ft <- flextable::line_spacing(ft, part = "footer", space = 0.9)
    }

    ft
  }

  merged_tbl <- if (engine == "gt") {
    build_gt_merge(merged_display, spanners, col_labels, theme, footnotes)
  } else {
    build_flex_merge(merged_display, spanners, col_labels, theme, footnotes)
  }

  engine_class <- if (engine == "gt") "gt_merge" else "ft_merge"

  part_sources <- vapply(
    tbls,
    function(x) {
      src <- x[["source"]]
      if (!is.null(src)) src else NA_character_
    },
    character(1)
  )

  part_formats <- vapply(
    tbls,
    function(x) {
      fmt <- x[["format"]]
      if (!is.null(fmt)) fmt else NA_character_
    },
    character(1)
  )

  res <- list(
    table = merged_tbl,
    table_display = merged_display,
    column_labels = col_labels,
    spanners = spanners,
    engine = engine,
    format = format,
    footnotes = footnotes,
    part_sources = part_sources,
    part_formats = part_formats,
    source = "merge_tables"
  )

  class(res) <- c("gtregression", "merged_table", engine_class, "list")
  res
}

# -------------------------------------------------------------------
# print method
# -------------------------------------------------------------------

#' @export
print.merged_table <- function(x, ...) {
  tbl <- x[["table"]]
  if (inherits(tbl, "gt_tbl") || inherits(tbl, "flextable")) {
    base::print(tbl)
  } else {
    utils::str(x)
  }
  invisible(x)
}
