#' Generation and Analysis of Confounded and Fractional Factorial Block Designs
#'
#' Internal package-level roxygen directives used to generate the
#' package `NAMESPACE` automatically with roxygen2.
#'
#' @keywords internal
#' @importFrom MASS ginv
#' @importFrom Matrix rankMatrix
#' @importFrom stats as.formula contr.helmert contr.sum contrasts contrasts<- model.matrix rnorm terms
#' @importFrom utils combn
"_PACKAGE"

#' Generate the full ternary construction matrix
#'
#' Builds the full recursive ternary matrix used as the foundation for
#' generating complete, fractional, and confounded 3-level factorial
#' layouts in this script.
#'
#' @param n Integer. Number of recursion levels (or factors).
#'
#' @return A matrix with entries in \code{0}, \code{1}, and \code{2}
#'   representing the full ternary construction after \code{n}
#'   recursive expansions.
#'
#' @details
#' The construction starts from a single-column seed and applies the
#' 3-by-3 recursive expansion rule `n` times. The returned matrix is
#' transposed so that downstream functions can extract the square design
#' submatrix directly.
#'
#' @examples
#' generate_Tn_full(1)
#' dim(generate_Tn_full(2))
#' @examples
#' get_Tn_square(1)
#' dim(get_Tn_square(2))
#' @examples
#' d <- lfbd(2)
#' d
#' nrow(d)
#' @examples
#' d <- lfbd.fr(2, 1)
#' d
#' attr(d, "defining_contrasts")
#' @examples
#' lfbd.cf(2, 1)
#' dim(lfbd.cf(3, 2))
#' @examples
#' d <- lfbd.cf.full(2, 1)
#' d
#' colnames(d)
#' @examples
#' d <- lfbd(2)
#' blk <- convert_to_blocks(d)
#' blk
#' @examples
#' d <- lfbd.cf.full(2, 1)
#' convert_to_blocks(d)
#' @examples
#' d <- lfbd.cf.full(2, 1)
#' blk <- convert_to_blocks(d)
#' build_block_matrix(blk)
#' @examples
#' X <- build_effect_matrix(NULL, c(3, 3))
#' dim(X)
#' head(X)
#' @examples
#' d <- lfbd.cf.full(2, 1)
#' blk <- convert_to_blocks(d)
#' res <- FactChar(c(3, 3), blk)
#' print(res)
#' @examples
#' res <- lfbd_analyze(
#'   type = "lfbd.cf.full",
#'   factor_levels = c(3, 3),
#'   n = 2,
#'   r = 1,
#'   show_design = FALSE,
#'   run_analysis = FALSE
#' )
#' names(res)
#'
#' @seealso [get_Tn_square()], [lfbd()], [lfbd.fr()], [lfbd.cf()]
#' @export
#' @references
#' Elsawah, A.M. Multiple doubling: a simple effective construction
#' technique for optimal two-level experimental designs. \emph{Statistical
#' Papers} \strong{62}, 2923--2967 (2021).
#' DOI: 10.1007/s00362-020-01221-0
#'
#' Gupta, S. C. (1983).
#' Some new methods for constructing block designs having orthogonal factorial structure.
#' Journal of the Royal Statistical Society, Series B (Methodological), 45, 297-307.
generate_Tn_full <- function(n) {

  T_prev <- matrix(c(0, 1, 2), ncol = 1)

  if (n == 0) return(T_prev)

  for (k in 1:n) {
    v <- 3

    A    <- T_prev
    A_I1 <- (A + 1) %% v
    A_I2 <- (A + 2) %% v

    top    <- cbind(A, A, A)
    middle <- cbind(A, A_I1, A_I2)
    bottom <- cbind(A, A_I2, A_I1)

    T_prev <- rbind(top, middle, bottom)
  }

  return(t(T_prev))
}

#' Extract the square design matrix for a 3-level factorial construction
#'
#' Computes the square submatrix used as the base design matrix for the
#' LFBD generators.
#'
#' @param n Integer. Number of factors.
#'
#' @return A `3^n x n?` style square matrix derived from the full ternary
#'   construction, with the first `3^n` rows retained after transposition.
#'
#' @seealso [generate_Tn_full()], [lfbd()], [lfbd.fr()], [lfbd.cf()]
#' @export
get_Tn_square <- function(n) {
  T_full <- t(generate_Tn_full(n))
  Tn <- T_full[1:(3^n), ]
  return(Tn)
}

# ------------------------------------------------------------
# Complete factorial LFBD
# ------------------------------------------------------------
#' Generate a complete factorial LFBD
#'
#' Creates the complete 3-level factorial layout from the ternary design
#' construction and returns treatment labels in run order.
#'
#' @param n Integer. Number of factors.
#'
#' @return A data frame with columns:
#' \describe{
#'   \item{Run}{Run labels such as `"run1"`, `"run2"`, ...}
#'   \item{Treatment}{Treatment combination labels formed by concatenating
#'   factor levels coded as `0`, `1`, and `2`.}
#' }
#'
#' @seealso [lfbd.fr()], [lfbd.cf.full()], [lfbd_analyze()]
#' @export
lfbd <- function(n) {

  Tn <- get_Tn_square(n)

  cols_sel <- 3^(0:(n - 1))
  design <- Tn[, cols_sel, drop = FALSE]

  trt <- apply(design, 1, paste0, collapse = "")

  result <- data.frame(
    Run = paste0("run", seq_along(trt)),
    Treatment = trt,
    stringsAsFactors = FALSE
  )

  return(result)
}

# ------------------------------------------------------------
# Core recursive selector
# ------------------------------------------------------------
# This is the corrected logic.
#
# For a matrix with 3^m rows:
# - split into 3 equal consecutive parts
# - recursively construct three patterns P1, P2, P3
# - for fractional:
#     base on 9 rows:
#       A1 = rows 1,2,3
#       A2 = rows 4,5,6
#       A3 = rows 7,8,9
# - for confounded:
#     base on 9 rows:
#       A1 = rows 1,4,7
#       A2 = rows 2,5,8
#       A3 = rows 3,6,9
# - higher levels use cyclic stacking:
#       P1 = [child1 ; child2 ; child3]
#       P2 = [child3 ; child1 ; child2]
#       P3 = [child2 ; child3 ; child1]
#
# Then the first selected reduced design is always P1.
# ------------------------------------------------------------
#' Build recursive triplets for fractional or confounded reduction
#'
#' Recursively partitions a design matrix into three components and returns
#' three reduced patterns used in the fractional and confounded selection
#' rules.
#'
#' @param mat Matrix to be partitioned and reduced.
#' @param type Character string specifying the reduction rule. Must be one of
#'   `"fractional"` or `"confounded"`.
#'
#' @return A list of three matrices, conventionally interpreted as `P1`, `P2`,
#'   and `P3`.
#'
#' @details
#' For 9-row base cases, the selection rule differs by `type`.
#' Fractional reduction uses consecutive row groups, whereas confounded
#' reduction uses interleaved row groups. Larger matrices are handled
#' recursively.
#'
#' @keywords internal
#' @seealso [reduce_once()], [reduce_repeated()]
build_triplet <- function(mat, type = c("fractional", "confounded")) {

  type <- match.arg(type)
  N <- nrow(mat)

  if (N < 3 || (N %% 3 != 0)) {
    stop("Number of rows must be divisible by 3.")
  }

  # ---- Smallest base case: 3 rows ----
  # Restriction requested by user:
  # for confounded factorial also use 1,2,3 when only 3 rows are needed
  if (N == 3) {
    A1 <- mat[1, , drop = FALSE]
    A2 <- mat[2, , drop = FALSE]
    A3 <- mat[3, , drop = FALSE]
    return(list(A1, A2, A3))
  }

  # ---- Base case: 9 rows ----
  if (N == 9) {
    if (type == "fractional") {
      A1 <- mat[c(1, 2, 3), , drop = FALSE]
      A2 <- mat[c(4, 5, 6), , drop = FALSE]
      A3 <- mat[c(7, 8, 9), , drop = FALSE]
    } else {
      A1 <- mat[c(1, 4, 7), , drop = FALSE]
      A2 <- mat[c(2, 5, 8), , drop = FALSE]
      A3 <- mat[c(3, 6, 9), , drop = FALSE]
    }
    return(list(A1, A2, A3))
  }

  # ---- Recursive case ----
  k <- N / 3

  G1 <- mat[1:k, , drop = FALSE]
  G2 <- mat[(k + 1):(2 * k), , drop = FALSE]
  G3 <- mat[(2 * k + 1):(3 * k), , drop = FALSE]

  T1 <- build_triplet(G1, type)
  T2 <- build_triplet(G2, type)
  T3 <- build_triplet(G3, type)

  P1 <- rbind(T1[[1]], T2[[2]], T3[[3]])
  P2 <- rbind(T1[[3]], T2[[1]], T3[[2]])
  P3 <- rbind(T1[[2]], T2[[3]], T3[[1]])

  return(list(P1, P2, P3))
}

# one-step reduction by factor 3
#' Reduce a design matrix by one factor of three
#'
#' Applies a single fractional or confounded reduction step to a design
#' matrix by selecting the first recursive pattern returned by
#' [build_triplet()].
#'
#' @param mat Matrix to reduce.
#' @param type Character string specifying `"fractional"` or `"confounded"`.
#'
#' @return A reduced matrix with one-third as many rows as `mat` when reduction
#'   is possible.
#'
#' @keywords internal
#' @seealso [build_triplet()], [reduce_repeated()]
reduce_once <- function(mat, type = c("fractional", "confounded")) {
  type <- match.arg(type)

  if (nrow(mat) == 3) return(mat)
  if (nrow(mat) < 9) stop("Cannot reduce further from fewer than 9 rows.")

  build_triplet(mat, type)[[1]]
}

# repeated reduction
#' Repeatedly reduce a design matrix
#'
#' Applies [reduce_once()] iteratively to obtain a smaller fractional or
#' confounded design.
#'
#' @param mat Matrix to reduce.
#' @param times Non-negative integer giving the number of repeated reduction
#'   steps.
#' @param type Character string specifying `"fractional"` or `"confounded"`.
#'
#' @return A matrix obtained after `times` successive reductions.
#'
#' @keywords internal
#' @seealso [reduce_once()], [lfbd.fr()], [lfbd.cf()]
reduce_repeated <- function(mat, times, type = c("fractional", "confounded")) {
  type <- match.arg(type)

  current <- mat
  if (times < 0) stop("times must be non-negative")

  for (i in seq_len(times)) {
    current <- reduce_once(current, type)
  }
  current
}
# ------------------------------------------------------------
# Helpers for defining contrasts and alias / confounding summary
# ------------------------------------------------------------

#' Compute the order of an effect vector
#'
#' Counts the number of nonzero coefficients in a mod-3 effect vector.
#'
#' @param v Numeric vector encoding an effect in mod 3 arithmetic.
#'
#' @return Integer giving the number of active factors in the effect.
#'
#' @keywords internal
#' @seealso [effect_label()], [canonical_effect()]
effect_order <- function(v) {
  sum(v %% 3 != 0)
}

#' Convert an effect vector to a compact label
#'
#' Converts a mod-3 effect vector to the string representation used
#' throughout the aliasing and confounding summaries.
#'
#' @param v Numeric vector encoding an effect in mod 3 arithmetic.
#'
#' @return A character string such as `"I"`, `"F11"`, or `"F11F22"`.
#'
#' @keywords internal
#' @seealso [effect_order()], [canonical_effect()]
effect_label <- function(v) {
  idx <- which(v %% 3 != 0)
  if (length(idx) == 0) return("I")
  paste0(paste0("F", idx, v[idx] %% 3), collapse = "")
}

#' Canonicalize a mod-3 effect vector
#'
#' Standardizes a nonzero effect vector so that its first nonzero coefficient
#' is equal to `1` in mod-3 arithmetic.
#'
#' @param v Numeric vector encoding an effect in mod 3 arithmetic.
#'
#' @return A canonicalized numeric vector in mod 3.
#'
#' @keywords internal
#' @seealso [effect_label()], [find_defining_contrasts()]
canonical_effect <- function(v) {
  v <- v %% 3
  nz <- which(v != 0)
  if (length(nz) == 0) return(v)

  # make first nonzero coefficient equal to 1
  if (v[nz[1]] == 2) v <- (2 * v) %% 3
  v
}

#' Compute matrix rank over the field of integers mod 3
#'
#' Performs Gaussian elimination modulo 3 to determine the rank of a matrix.
#'
#' @param M Matrix-like object.
#'
#' @return Integer rank of `M` computed under mod-3 arithmetic.
#'
#' @keywords internal
#' @seealso [is_independent_mod3()]
rank_mod3 <- function(M) {
  if (is.null(M) || length(M) == 0) return(0L)

  M <- as.matrix(M) %% 3
  nr <- nrow(M)
  nc <- ncol(M)

  if (nr == 0 || nc == 0) return(0L)

  r <- 1
  c <- 1
  rk <- 0L

  while (r <= nr && c <= nc) {
    piv_rel <- which(M[r:nr, c] != 0)

    if (length(piv_rel) == 0) {
      c <- c + 1
      next
    }

    piv <- piv_rel[1] + r - 1

    # swap pivot row into position
    if (piv != r) {
      tmp <- M[r, ]
      M[r, ] <- M[piv, ]
      M[piv, ] <- tmp
    }

    # normalize pivot row
    if (M[r, c] == 2) {
      M[r, ] <- (2 * M[r, ]) %% 3   # inverse of 2 mod 3 is 2
    }

    # eliminate pivot column from all other rows
    for (i in seq_len(nr)) {
      if (i != r && M[i, c] != 0) {
        M[i, ] <- (M[i, ] - M[i, c] * M[r, ]) %% 3
        M[i, ] <- (M[i, ] + 3) %% 3
      }
    }

    rk <- rk + 1L
    r <- r + 1
    c <- c + 1
  }

  rk
}

#' Test linear independence modulo 3
#'
#' Checks whether adding a vector to an existing basis increases its
#' mod-3 rank.
#'
#' @param B Matrix whose columns form the current basis.
#' @param v Vector to test for independence.
#'
#' @return Logical value; `TRUE` if `v` is independent of the columns of `B`
#'   over mod 3, otherwise `FALSE`.
#'
#' @keywords internal
#' @seealso [rank_mod3()], [find_defining_contrasts()]
is_independent_mod3 <- function(B, v) {
  v <- matrix(v %% 3, ncol = 1)

  if (is.null(B) || ncol(B) == 0) return(any(v != 0))

  rank_mod3(cbind(B, v)) > rank_mod3(B)
}

#' Find defining contrasts for a fractional design
#'
#' Searches the effect space for mod-3 contrasts satisfied by a design matrix
#' and extracts an independent basis of defining contrasts.
#'
#' @param design_mat Design matrix whose rows correspond to treatment
#'   combinations and whose columns correspond to factors.
#' @param expected_c Optional integer giving the expected number of defining
#'   contrasts to retain.
#'
#' @return A list with components:
#' \describe{
#'   \item{basis}{A matrix whose columns form an independent basis of defining
#'   contrasts.}
#'   \item{labels}{Character vector of labels for the defining contrasts.}
#' }
#'
#' @keywords internal
#' @seealso [defining_subgroup()], [fractional_confounding_summary()], [lfbd.fr()]
find_defining_contrasts <- function(design_mat, expected_c = NULL) {

  n <- ncol(design_mat)

  all_eff <- as.matrix(expand.grid(rep(list(0:2), n)))
  all_eff <- all_eff[-1, , drop = FALSE]   # remove zero effect

  chk <- (design_mat %*% t(all_eff)) %% 3
  valid <- colSums(chk != 0) == 0

  valid_eff <- all_eff[valid, , drop = FALSE]

  if (nrow(valid_eff) == 0) {
    return(list(
      basis = matrix(0, nrow = n, ncol = 0),
      labels = character(0)
    ))
  }

  canon <- t(apply(valid_eff, 1, canonical_effect))
  keys <- apply(canon, 1, paste0, collapse = "")
  labs <- apply(canon, 1, effect_label)
  ords <- apply(canon, 1, effect_order)

  keep <- !duplicated(keys)
  canon <- canon[keep, , drop = FALSE]
  labs  <- labs[keep]
  ords  <- ords[keep]

  o <- order(ords, labs)
  canon <- canon[o, , drop = FALSE]
  labs  <- labs[o]

  B <- matrix(0, nrow = n, ncol = 0)
  BL <- character(0)

  for (i in seq_len(nrow(canon))) {
    v <- canon[i, ]
    if (is_independent_mod3(B, v)) {
      B <- cbind(B, v)
      BL <- c(BL, effect_label(v))
      if (!is.null(expected_c) && ncol(B) == expected_c) break
    }
  }

  list(basis = B, labels = BL)
}

#' Generate the defining subgroup from a defining-contrast basis
#'
#' Forms all mod-3 linear combinations of the supplied defining contrasts.
#'
#' @param B Matrix whose columns are defining contrasts.
#'
#' @return A matrix whose rows enumerate the defining subgroup.
#'
#' @keywords internal
#' @seealso [find_defining_contrasts()], [low_order_aliases_from_subgroup()]
defining_subgroup <- function(B) {
  if (is.null(B) || ncol(B) == 0) {
    return(matrix(0, nrow = 1, ncol = nrow(B)))
  }

  k <- ncol(B)
  coeffs <- as.matrix(expand.grid(rep(list(0:2), k)))
  (coeffs %*% t(B)) %% 3
}

#' Generate a catalog of effects up to a chosen order
#'
#' Enumerates main effects and, optionally, two-factor interactions for a
#' symmetric factorial design coded in mod 3.
#'
#' @param n Integer. Number of factors.
#' @param max_order Maximum interaction order to include. Currently used for
#'   main effects and two-factor interactions.
#'
#' @return A list with components `mat`, `labels`, and `orders`.
#'
#' @keywords internal
#' @seealso [fractional_confounding_summary()]
generate_effect_catalog <- function(n, max_order = 2) {

  eff_list <- list()
  idx <- 1

  # main effects
  for (i in seq_len(n)) {
    for (a in 1:2) {
      v <- rep(0, n)
      v[i] <- a
      eff_list[[idx]] <- v
      idx <- idx + 1
    }
  }

  # two-factor interactions
  if (max_order >= 2 && n >= 2) {
    pairs <- combn(n, 2, simplify = FALSE)
    for (pp in pairs) {
      i <- pp[1]
      j <- pp[2]
      for (a in 1:2) {
        for (b in 1:2) {
          v <- rep(0, n)
          v[i] <- a
          v[j] <- b
          eff_list[[idx]] <- v
          idx <- idx + 1
        }
      }
    }
  }

  mat <- do.call(rbind, eff_list)
  labels <- apply(mat, 1, effect_label)
  orders <- apply(mat, 1, effect_order)

  list(mat = mat, labels = labels, orders = orders)
}

#' List low-order aliases for an effect
#'
#' Computes low-order aliases of a target effect using a supplied defining
#' subgroup.
#'
#' @param v Target effect vector.
#' @param subgroup Matrix whose rows represent subgroup elements.
#' @param max_order Maximum order of aliases to retain.
#'
#' @return A sorted character vector of aliased low-order effects.
#'
#' @keywords internal
#' @seealso [low_order_aliases_from_subgroup()]
effect_aliases_low_order <- function(v, subgroup, max_order = 2) {

  alias_mat <- (subgroup + matrix(v, nrow = nrow(subgroup), ncol = length(v), byrow = TRUE)) %% 3

  self_key <- paste0(v, collapse = "")
  keys <- apply(alias_mat, 1, paste0, collapse = "")
  ords <- apply(alias_mat, 1, effect_order)

  keep <- keys != self_key & ords > 0 & ords <= max_order

  if (!any(keep)) {
    return(character(0))
  }

  out <- apply(alias_mat[keep, , drop = FALSE], 1, effect_label)
  sort(unique(out))
}
# direct aliases of an effect with the defining contrasts
#' Compute direct aliases from defining contrasts
#'
#' Combines an effect with each defining contrast, and optionally with
#' multiples of each contrast, to obtain direct aliases.
#'
#' @param v Target effect vector.
#' @param dc_basis Matrix of defining contrasts.
#' @param include_multiples Logical; if `TRUE`, also include aliases generated
#'   by twice each defining contrast modulo 3.
#'
#' @return A character vector of unique direct aliases.
#'
#' @keywords internal
#' @seealso [find_defining_contrasts()], [low_order_aliases_from_subgroup()]
direct_aliases_from_dc <- function(v, dc_basis, include_multiples = FALSE) {

  if (is.null(dc_basis) || ncol(dc_basis) == 0) return(character(0))

  out <- character(0)

  for (j in seq_len(ncol(dc_basis))) {
    d <- dc_basis[, j] %% 3

    # E * DC
    a1 <- (v + d) %% 3
    out <- c(out, effect_label(a1))

    # optional: E * DC^2
    if (include_multiples) {
      a2 <- (v + 2 * d) %% 3
      out <- c(out, effect_label(a2))
    }
  }

  out <- out[out != "I"]
  unique(out)
}

# lowest-order aliases from full defining subgroup
#' Compute low-order aliases from a defining subgroup
#'
#' Adds a target effect to each subgroup element and retains aliases whose
#' order does not exceed `max_order`.
#'
#' @param v Target effect vector.
#' @param subgroup Matrix whose rows represent subgroup elements.
#' @param max_order Maximum order of aliases to retain.
#'
#' @return A sorted character vector of unique low-order aliases.
#'
#' @keywords internal
#' @seealso [defining_subgroup()], [fractional_confounding_summary()]
low_order_aliases_from_subgroup <- function(v, subgroup, max_order = 2) {

  alias_mat <- (subgroup + matrix(v, nrow = nrow(subgroup), ncol = length(v), byrow = TRUE)) %% 3

  self_key <- paste0(v %% 3, collapse = "")
  keys <- apply(alias_mat, 1, paste0, collapse = "")
  ords <- apply(alias_mat, 1, effect_order)

  keep <- keys != self_key & ords > 0 & ords <= max_order

  if (!any(keep)) return(character(0))

  out <- apply(alias_mat[keep, , drop = FALSE], 1, effect_label)
  sort(unique(out))
}
#' Summarize aliasing and confounding in a fractional LFBD
#'
#' Produces a low-order summary for main effects and two-factor interactions
#' under the defining subgroup of a fractional 3-level factorial design.
#'
#' @param n Integer. Number of factors.
#' @param dc_basis Matrix whose columns form the basis of defining contrasts.
#'
#' @return A data frame describing each listed effect, its order, low-order
#'   aliases, and simple estimability/confounding indicators.
#'
#' @seealso [find_defining_contrasts()], [lfbd.fr()]
fractional_confounding_summary <- function(n, dc_basis) {

  subgroup <- defining_subgroup(dc_basis)
  catalog <- generate_effect_catalog(n, max_order = 2)

  keep_idx <- which(catalog$orders %in% c(1, 2))

  out_list <- lapply(keep_idx, function(ii) {
    v <- catalog$mat[ii, ]
    ord <- catalog$orders[ii]

    aliases <- low_order_aliases_from_subgroup(v, subgroup, max_order = 2)

    data.frame(
      Effect = catalog$labels[ii],
      Order = ifelse(ord == 1, "Main Effect", "2FI"),
      Aliased_with = if (length(aliases) == 0) "-" else paste(aliases, collapse = ", "),
      Estimable = "YES",
      Confounded = "NO",
      stringsAsFactors = FALSE
    )
  })

  out <- do.call(rbind, out_list)
  rownames(out) <- NULL
  out
}
#' Generate a fractional 3-level LFBD
#'
#' Constructs a fractional layout from the complete ternary design by repeated
#' fractional reduction and returns the design together with defining contrasts
#' and a low-order confounding summary.
#'
#' @param n Integer. Number of factors.
#' @param c Integer. Degree of fractionation, so the final number of runs is
#'   `3^(n - c)`.
#'
#' @return An object of class `"lfbd_fr"` containing:
#' \describe{
#'   \item{design}{A data frame with run labels and treatment labels.}
#'   \item{design_matrix}{The reduced numeric design matrix.}
#'   \item{defining_contrasts}{Character vector of defining contrast labels.}
#'   \item{confounding_summary}{Data frame of main-effect and 2FI summaries.}
#' }
#'
#' @seealso [lfbd()], [lfbd.cf()], [lfbd_analyze()]
#' @examples
#' d <- lfbd.fr(2, 1)
#' d$design
#' d$defining_contrasts
#' @export
lfbd.fr <- function(n, c) {
  if (c < 0 || c > (n - 1)) {
    stop("For 3-level LFBD, c must satisfy 0 <= c <= n-1.")
  }

  Tn <- get_Tn_square(n)
  cols_sel <- 3^(0:(n - 1))
  Tn <- Tn[, cols_sel, drop = FALSE]

  current <- if (c == 0) Tn else reduce_repeated(Tn, times = c, type = "fractional")
  trt <- apply(current, 1, paste0, collapse = "")

  design <- data.frame(
    Run = paste0("run", seq_along(trt)),
    Treatment = trt,
    stringsAsFactors = FALSE
  )

  dc_obj <- find_defining_contrasts(current, expected_c = c)

  out <- list(
    design = design,
    design_matrix = current,
    defining_contrasts = dc_obj$labels,
    confounding_summary = fractional_confounding_summary(n, dc_obj$basis)
  )

  class(out) <- "lfbd_fr"
  out
}
#' @noRd
#' @export
print.lfbd_fr <- function(x, ...) {
  cat("\n================ GENERATED DESIGN (LFBD.FR) ================\n")
  print(x$design, row.names = FALSE)

  cat("\n================ DEFINING CONTRAST(S) ================\n")
  if (length(x$defining_contrasts) == 0) {
    cat("No nontrivial defining contrast.\n")
  } else {
    for (i in seq_along(x$defining_contrasts)) {
      cat(paste0("DC", i, ": I = ", x$defining_contrasts[i], "\n"))
    }
  }

  cat("\n================ CONFOUNDING SUMMARY: MAIN EFFECTS + 2FI ================\n")
  print(x$confounding_summary, row.names = FALSE)

  invisible(x)
}
# ------------------------------------------------------------
# Principal block for confounded factorial
# r = number of treatment combinations per block exponent
# principal block size = 3^r
# ------------------------------------------------------------
#' Generate the principal block for a confounded LFBD
#'
#' Extracts the principal block of size `3^r` from a complete 3-level
#' factorial design using the recursive confounded selection rule.
#'
#' @param n Integer. Number of factors.
#' @param r Integer. Exponent determining the principal block size, so the
#'   principal block contains `3^r` treatment combinations.
#'
#' @return A matrix representing the principal block.
#'
#' @seealso [lfbd.cf.full()], [reduce_repeated()]
#' @export
lfbd.cf <- function(n, r) {

  if (r < 1 || r > n) {
    stop("r must satisfy 1 <= r <= n.")
  }

  Tn <- get_Tn_square(n)
  cols_sel <- 3^(0:(n - 1))
  Tn <- Tn[, cols_sel, drop = FALSE]

  # Special restriction:
  # if required block size is 3 rows, select rows 1,2,3
  if (r == 1) {
    principal_block <- Tn[1:3, , drop = FALSE]
    return(principal_block)
  }

  # Otherwise use the confounded recursive rule
  times <- n - r

  if (times == 0) {
    principal_block <- Tn
  } else {
    principal_block <- reduce_repeated(Tn, times = times, type = "confounded")
  }

  return(principal_block)
}

# ------------------------------------------------------------
# Full confounded factorial design
# ------------------------------------------------------------
#' Generate the full confounded factorial design
#'
#' Builds the complete set of blocks induced by the principal block of a
#' confounded 3-level factorial design.
#'
#' @param n Integer. Number of factors.
#' @param r Integer. Exponent determining the principal block size.
#' @param max_blocks_display Integer. Reserved display helper parameter from the
#'   original script.
#'
#' @return An invisible data frame whose first column identifies units and whose
#'   remaining columns correspond to blocks (`blk1`, `blk2`, ...).
#'
#' @seealso [lfbd.cf()], [convert_to_blocks()], [FactChar()]
#' @export
lfbd.cf.full <- function(n, r, max_blocks_display = 12) {

  B0 <- lfbd.cf(n, r)

  v <- 3
  ncolB <- ncol(B0)
  num_blocks <- 3^(n - r)

  block_list <- vector("list", num_blocks)

  for (u in 0:(num_blocks - 1)) {

    shift_vec <- rep(0, ncolB)
    temp <- u

    for (j in 1:ncolB) {
      shift_vec[j] <- temp %% v
      temp <- temp %/% v
    }

    block <- sweep(B0, 2, shift_vec, "+") %% v
    trt <- apply(block, 1, paste0, collapse = "")

    block_list[[u + 1]] <- trt
  }

  mat <- do.call(cbind, block_list)

  result <- data.frame(
    Unit = paste0("unit", 1:nrow(mat)),
    mat,
    stringsAsFactors = FALSE
  )
  colnames(result)[-1] <- paste0("blk", 1:ncol(mat))

  # total_blocks <- ncol(mat)
  # splits <- split(1:total_blocks,
  #                 ceiling(seq_along(1:total_blocks) / max_blocks_display))
  #
  # for (i in seq_along(splits)) {
  #   cols <- splits[[i]]
  #
  #   cat("\n")
  #   cat("------------------------------------------------------------\n")
  #   cat(paste0("Blocks ", min(cols), " to ", max(cols), "\n"))
  #   cat("------------------------------------------------------------\n")
  #
  #   print(result[, c(1, cols + 1), drop = FALSE], row.names = FALSE)
  #   cat("\n")
  #}

  invisible(result)
}

# ------------------------------------------------------------
# Utilities for analysis
# ------------------------------------------------------------

#' Convert a run-ordered design into equal-sized blocks
#'
#' Splits the \code{Treatment} column of a run-ordered design data frame into
#' consecutive blocks of a specified size.
#'
#' @param design_df Data frame containing a \code{Treatment} column.
#' @param block_size Positive integer giving the number of treatments per block.
#'
#' @return A named list of character vectors, one vector per block.
#'
#' @keywords internal
as_blocks_from_runs <- function(design_df, block_size) {

  if (!"Treatment" %in% colnames(design_df)) {
    stop("design_df must contain a 'Treatment' column.")
  }

  if (length(block_size) != 1 || is.na(block_size) || block_size < 1 ||
      block_size != as.integer(block_size)) {
    stop("block_size must be a positive integer.")
  }

  trt <- design_df$Treatment

  if (length(trt) %% block_size != 0) {
    stop("Number of treatments must be divisible by block_size.")
  }

  idx <- ceiling(seq_along(trt) / block_size)
  blocks <- split(trt, idx)
  names(blocks) <- paste0("B", seq_along(blocks))
  blocks
}

#' Convert a full confounded LFBD data frame into blocks
#'
#' Extracts block columns from a data frame returned by \code{lfbd.cf.full()}.
#'
#' @param design_df Data frame containing a \code{Unit} column and one or more
#'   block columns.
#'
#' @return A named list of character vectors, one vector per block.
#'
#' @keywords internal
as_blocks_from_cf_full <- function(design_df) {

  if (!"Unit" %in% colnames(design_df)) {
    stop("design_df must contain a 'Unit' column.")
  }

  block_names <- setdiff(colnames(design_df), "Unit")

  if (length(block_names) == 0) {
    stop("design_df must contain at least one block column.")
  }

  blocks <- lapply(block_names, function(nm) design_df[[nm]])
  names(blocks) <- block_names
  blocks
}

#' Print a generated design
#'
#' Convenience printer used by \code{lfbd_analyze()} to display the generated
#' design object.
#'
#' @param design_df A generated design data frame.
#'
#' @return Invisibly returns \code{design_df}.
#'
#' @keywords internal
print_generated_design <- function(design_df) {
  print(design_df, row.names = FALSE)
  invisible(design_df)
}

#' Convert a generated design object to a block list
#'
#' Converts either a treatment-run data frame or a block-wise design data frame
#' into a named list of blocks.
#'
#' @param design_df Data frame returned by a design-generation function.
#'
#' @return A named list where each element is a character vector of treatment
#'   labels belonging to one block.
#'
#' @seealso [build_block_matrix()], [FactChar()]
#' @export
convert_to_blocks <- function(design_df) {

  if ("Treatment" %in% colnames(design_df)) {
    return(list(B1 = design_df$Treatment))
  }

  if ("Unit" %in% colnames(design_df)) {
    block_names <- colnames(design_df)[-1]
    blocks <- lapply(block_names, function(b) design_df[[b]])
    names(blocks) <- block_names
    return(blocks)
  }

  stop("Unknown design format")
}

#' Build a treatment-by-block incidence matrix
#'
#' Creates the incidence matrix for a block design from a list of treatment
#' labels grouped by block.
#'
#' @param blocks Named or unnamed list of blocks, where each block is a vector
#'   of treatment labels.
#'
#' @return A binary matrix with treatments in rows and blocks in columns.
#'
#' @seealso [convert_to_blocks()], [FactChar()]
#' @export
build_block_matrix <- function(blocks) {

  trts <- unique(unlist(blocks))
  v <- length(trts)
  b <- length(blocks)

  N <- matrix(0, v, b)
  rownames(N) <- trts

  for (j in 1:b) {
    for (trt in blocks[[j]]) {
      i <- match(trt, trts)
      N[i, j] <- 1
    }
  }

  return(N)
}

#' Build a model matrix for factorial effects
#'
#' Generates the treatment-effect model matrix for a factorial design using
#' sum-to-zero contrasts.
#'
#' @param trts Character vector of treatment labels. Included for interface
#'   compatibility with the original script.
#' @param factor_levels Integer vector giving the number of levels for each
#'   factor.
#'
#' @return A model matrix with one row per treatment combination.
#'
#' @seealso [FactChar()]
#' @export
build_effect_matrix <- function(trts, factor_levels) {

  grids <- do.call(expand.grid,
                   lapply(factor_levels, function(s) 0:(s - 1)))

  grids <- grids[, seq_along(factor_levels), drop = FALSE]
  df <- as.data.frame(grids)

  for (i in seq_along(df)) {
    df[[i]] <- factor(df[[i]])
    contrasts(df[[i]]) <- contr.sum(nlevels(df[[i]]))
  }

  form <- paste0("~ (", paste(names(df), collapse = "*"), ") - 1")

  X <- model.matrix(as.formula(form), data = df)
  rownames(X) <- apply(grids, 1, paste0, collapse = "")

  return(X)
}
#' Analyze factorial block-design characteristics
#'
#' Computes incidence-based, estimability, balance, confounding, discrepancy,
#' and optimality summaries for a factorial block design.
#'
#' @param factor_levels Integer vector giving the number of levels for each
#'   factor.
#' @param blocks List of blocks, where each block is a character vector of
#'   treatment labels.
#'
#' @return An object of class `"lfebd3_analysis"` containing the incidence
#'   matrix, C-matrix, design-property flags, confounding summary, discrepancy
#'   criteria, optimality diagnostics, and Das-style summaries. Use
#'   `print()` to display the formatted report.
#'
#' @details
#' This function contains several local helper functions for pseudo-inverse
#' calculation, contrast construction, Das-style diagnostics, discrepancy
#' measures, and confounding checks. Those helper functions are scoped locally
#' and are not intended to be documented as separate package-level functions.
#'
#' @seealso [build_block_matrix()], [lfbd_analyze()], [lfbd.cf.full()]
#' @export
FactChar <- function(factor_levels, blocks) {

  mpinv <- function(A, tol = 1e-8) {
    sv <- svd(A)
    d <- ifelse(sv$d > tol, 1 / sv$d, 0)
    sv$v %*% diag(d, nrow = length(d)) %*% t(sv$u)
  }

  ensure_col <- function(x, v) matrix(as.numeric(x), nrow = v, ncol = 1)
  is_zero_vec <- function(x, tol = 1e-10) all(abs(x) < tol)

  build_incidence <- function(levels, blocks) {
    grids <- do.call(expand.grid, lapply(rev(levels), function(s) 0:(s - 1)))
    grids <- grids[, rev(seq_len(ncol(grids))), drop = FALSE]
    trt_labels <- apply(grids, 1, paste0, collapse = "")
    v <- length(trt_labels)
    b <- length(blocks)

    N <- matrix(0, nrow = v, ncol = b)
    rownames(N) <- trt_labels
    colnames(N) <- paste0("B", seq_len(b))

    for (h in seq_len(b)) {
      for (trt in blocks[[h]]) {
        pos <- match(trt, trt_labels)
        if (is.na(pos)) {
          stop(sprintf("Block %d contains treatment '%s' not in treatment list", h, trt))
        }
        N[pos, h] <- N[pos, h] + 1
      }
    }

    list(N = N, treatments = trt_labels, grids = grids)
  }

  compute_Cmatrix <- function(N) {
    v <- nrow(N)
    b <- ncol(N)
    r <- rowSums(N)
    k <- colSums(N)
    Rdel <- diag(as.numeric(r), v, v)
    Kdel <- diag(as.numeric(k), b, b)
    C <- Rdel - N %*% solve(Kdel) %*% t(N)
    list(C = C, r = r, k = k)
  }

  build_contrast_matrix <- function(grids) {
    df <- as.data.frame(grids, stringsAsFactors = TRUE)

    for (nm in names(df)) {
      df[[nm]] <- as.factor(df[[nm]])
      contrasts(df[[nm]]) <- contr.sum(nlevels(df[[nm]]))
    }

    form <- paste0("~ (", paste(names(df), collapse = "*"), ") - 1")
    mm <- model.matrix(as.formula(form), data = df)
    assign_vec <- attr(mm, "assign")
    term_labels <- attr(terms(as.formula(form), data = df), "term.labels")
    effects <- sapply(assign_vec, function(a) if (a == 0) "(Intercept)" else term_labels[a])
    attr(mm, "effect") <- effects
    mm
  }

  is_estimable <- function(C, l, tol = 1e-8) {
    v <- nrow(C)
    lcol <- ensure_col(l, v)
    Cplus <- mpinv(C)
    diff <- C %*% Cplus %*% lcol - lcol
    all(abs(diff) < tol)
  }

  contrast_var_factor <- function(C, l) {
    v <- nrow(C)
    lcol <- ensure_col(l, v)
    as.numeric(t(lcol) %*% mpinv(C) %*% lcol)
  }

  evaluate_balance <- function(C, mm, tol = 1e-8, var_tol = 1e-8) {
    effects <- unique(attr(mm, "effect"))
    results <- list()

    for (eff in effects) {
      idx <- which(attr(mm, "effect") == eff)
      cols <- mm[, idx, drop = FALSE]
      est_flags <- logical(ncol(cols))
      vars <- rep(NA_real_, ncol(cols))

      for (j in seq_len(ncol(cols))) {
        l <- cols[, j]
        if (is_zero_vec(l, tol)) next
        lnorm <- l / sqrt(sum(l^2))
        est_flags[j] <- is_estimable(C, lnorm, tol)
        if (est_flags[j]) vars[j] <- contrast_var_factor(C, lnorm)
      }

      if (all(!est_flags)) {
        balanced <- TRUE
        reason <- "no contrast estimable"
      } else if (all(est_flags)) {
        if ((max(vars, na.rm = TRUE) - min(vars, na.rm = TRUE)) < var_tol) {
          balanced <- TRUE
          reason <- "equal variance"
        } else {
          balanced <- FALSE
          reason <- "unequal variance"
        }
      } else {
        balanced <- FALSE
        reason <- "partial estimability"
      }

      results[[eff]] <- list(balanced = balanced, reason = reason)
    }

    results
  }

  check_design_OFS <- function(factor_levels, blocks) {
    decode_treatment <- function(trt) as.numeric(strsplit(trt, "")[[1]])

    code_levels <- function(s) {
      if (s %% 2 == 1) {
        seq(-(s - 1) / 2, (s - 1) / 2, by = 1)
      } else {
        seq(-(s - 1), (s - 1), by = 2)
      }
    }

    all_treatments <- unique(unlist(blocks))
    if (length(all_treatments) == 0) return(list(OFS = FALSE, mean_corr = NA))

    m <- nchar(all_treatments[1])
    design_data <- data.frame()

    for (b in seq_along(blocks)) {
      block <- blocks[[b]]
      for (t in block) {
        factors <- decode_treatment(t)
        design_data <- rbind(design_data, cbind(Block = paste0("B", b), t(factors)))
      }
    }

    colnames(design_data)[-1] <- paste0("F", 1:m)

    coded_data <- design_data
    for (i in 1:m) {
      s <- factor_levels[i]
      if (is.na(s) || s < 1) return(list(OFS = FALSE, mean_corr = NA))

      code_map <- code_levels(s)
      map_df <- data.frame(orig = 0:(s - 1), coded = code_map)

      coded_data[[paste0("F", i)]] <- sapply(
        design_data[[paste0("F", i)]],
        function(x) map_df$coded[map_df$orig == x]
      )
    }

    form_str <- paste("~ (", paste(colnames(coded_data)[-1], collapse = " + "), ")^", m, sep = "")
    form <- as.formula(form_str)

    X <- tryCatch(
      model.matrix(form, data = coded_data[, -1, drop = FALSE])[, -1, drop = FALSE],
      error = function(e) return(NULL)
    )
    if (is.null(X)) return(list(OFS = FALSE, mean_corr = NA))

    blk_levels <- unique(as.character(coded_data$Block))
    blk_factor <- factor(as.character(coded_data$Block), levels = blk_levels)

    B <- matrix(0, nrow = nrow(coded_data), ncol = length(blk_levels))
    for (i in seq_len(nrow(coded_data))) {
      B[i, as.integer(blk_factor[i])] <- 1
    }

    Q <- diag(nrow(X)) - B %*% solve(t(B) %*% B) %*% t(B)
    X_adj <- Q %*% X
    Cmat <- t(X_adj) %*% X_adj + diag(1e-12, ncol(X_adj))

    d <- sqrt(diag(Cmat))
    d[d == 0 | is.na(d)] <- 1
    corC <- Cmat / (d %o% d)
    offdiag_mean <- mean(abs(corC[upper.tri(corC)]), na.rm = TRUE)

    list(OFS = (offdiag_mean < 1e-8), mean_corr = offdiag_mean)
  }

  compute_Hd_DD_mixed <- function(Td, q_vec, a = 1, b = 0.5) {
    if (!is.matrix(Td)) Td <- as.matrix(Td)
    n <- nrow(Td)
    s <- ncol(Td)

    hamming_col <- function(x) outer(x, x, Vectorize(function(i, j) as.numeric(i != j)))
    H_list <- lapply(1:s, function(k) hamming_col(Td[, k]))
    Hd_total <- Reduce("+", H_list)

    term1 <- -prod(a + (q_vec - 1) * b / q_vec)
    term2_sum <- 0

    for (i in 1:n) {
      for (j in 1:n) {
        prod_ij <- prod(sapply(1:s, function(k) a * (b / a)^(H_list[[k]][i, j])))
        term2_sum <- term2_sum + prod_ij
      }
    }

    term2 <- term2_sum / (n^2)
    DD2 <- term1 + term2
    DD <- sqrt(abs(DD2))

    list(Hd_total = Hd_total, DD = DD)
  }

  if (!exists("das_ginv_safe", mode = "function")) {
    das_ginv_safe <- function(A, tol = 1e-8) {
      MASS::ginv(as.matrix(A), tol = tol)
    }
  }

  if (!exists("das_compute_Cmatrix", mode = "function")) {
    das_compute_Cmatrix <- function(N, k_vec = NULL, r_vec = NULL) {
      N <- as.matrix(N)
      v <- nrow(N)
      b <- ncol(N)

      if (is.null(k_vec)) k_vec <- colSums(N)
      if (is.null(r_vec)) r_vec <- rowSums(N)

      if (length(k_vec) != b) stop("k_vec length mismatch")
      if (length(r_vec) != v) stop("r_vec length mismatch")
      if (any(k_vec == 0)) stop("Some block sizes are zero")

      Rmat <- diag(as.numeric(r_vec), nrow = v)
      Kinv <- diag(1 / as.numeric(k_vec), nrow = b)
      C <- Rmat - N %*% Kinv %*% t(N)

      list(C = as.matrix(C), R = Rmat, Kinv = Kinv, N = N, r_vec = r_vec, k_vec = k_vec)
    }
  }

  if (!exists("das_make_Pi", mode = "function")) {
    das_make_Pi <- function(s) {
      s <- as.integer(s)
      if (s <= 1) stop("Each factor must have at least 2 levels.")

      H <- contr.helmert(s)
      first_col <- rep(1 / sqrt(s), s)
      Q <- qr.Q(qr(H))
      P <- cbind(first_col, Q)

      if (ncol(P) < s) {
        last_extra <- qr.Q(qr(matrix(rnorm(s * (s - ncol(P))), nrow = s)))
        needed <- s - ncol(P)
        P <- cbind(P, last_extra[, 1:needed, drop = FALSE])
      }

      if (sum(P[, 1]) < 0) P[, 1] <- -P[, 1]
      return(P)
    }
  }

  if (!exists("das_build_effect_contrasts", mode = "function")) {
    das_build_effect_contrasts <- function(s_vec, alpha) {
      m <- length(s_vec)
      if (length(alpha) != m) stop("alpha length must equal number of factors")

      Pi_list <- lapply(s_vec, das_make_Pi)

      col_blocks <- lapply(seq_len(m), function(i) {
        Pi <- Pi_list[[i]]
        if (alpha[i] == 0) {
          Pi[, 1, drop = FALSE]
        } else {
          Pi[, -1, drop = FALSE]
        }
      })

      Tcon <- col_blocks[[1]]
      if (m >= 2) {
        for (i in 2:m) {
          Tcon <- kronecker(Tcon, col_blocks[[i]])
        }
      }

      return(Tcon)
    }
  }

  if (!exists("das_enumerate_all_effects", mode = "function")) {
    das_enumerate_all_effects <- function(s_vec) {
      m <- length(s_vec)
      all_alpha <- do.call(expand.grid, rep(list(c(0, 1)), m))
      res <- list()

      for (i in seq_len(nrow(all_alpha))) {
        alpha <- as.integer(all_alpha[i, ])
        if (all(alpha == 0)) next
        Tcon <- das_build_effect_contrasts(s_vec, alpha)
        res[[length(res) + 1]] <- list(alpha = alpha, contrasts = Tcon)
      }

      return(res)
    }
  }

  if (!exists("das_check_effect_balance", mode = "function")) {
    das_check_effect_balance <- function(Cmat, contrasts, tol = 1e-6) {
      Cg <- tryCatch(das_ginv_safe(Cmat), error = function(e) NULL)
      if (is.null(Cg)) stop("Failed to pseudo-invert C")

      cov_block <- t(contrasts) %*% Cg %*% contrasts
      estimable_cols <- apply(contrasts, 2, function(col) sqrt(sum((Cmat %*% col)^2)) > tol)
      estimable <- all(estimable_cols)
      f <- ncol(cov_block)
      s_est <- sum(diag(cov_block)) / f
      residual_mat <- cov_block - s_est * diag(f)
      balanced <- max(abs(residual_mat)) < tol

      list(
        estimable = estimable,
        balanced = balanced,
        scalar = s_est,
        cov = cov_block,
        max_offdiag = max(abs(residual_mat))
      )
    }
  }

  if (!exists("das_check_pairwise_orthogonality", mode = "function")) {
    das_check_pairwise_orthogonality <- function(Cmat, T1, T2, tol = 1e-6) {
      Cg <- das_ginv_safe(Cmat)
      crosscov <- t(T1) %*% Cg %*% T2
      list(
        is_orthogonal = max(abs(crosscov)) < tol,
        crosscov = crosscov,
        max_abs = max(abs(crosscov))
      )
    }
  }

  if (!exists("das_analyze_design", mode = "function")) {
    das_analyze_design <- function(s_vec, N, check_all_pairs = FALSE, tol = 1e-6) {
      cm <- das_compute_Cmatrix(N)
      C <- cm$C
      eigs <- eigen((C + t(C)) / 2, symmetric = TRUE, only.values = TRUE)$values
      rankC <- qr(C)$rank
      effects <- das_enumerate_all_effects(s_vec)
      effects_summary <- list()

      for (i in seq_along(effects)) {
        alpha <- effects[[i]]$alpha
        Tcon <- effects[[i]]$contrasts
        chk <- das_check_effect_balance(C, Tcon, tol = tol)

        effects_summary[[i]] <- list(
          alpha = alpha,
          f_alpha = ncol(Tcon),
          estimable = chk$estimable,
          balanced = chk$balanced,
          balance_scalar = chk$scalar,
          max_offdiag = chk$max_offdiag
        )
      }

      pairwise <- NULL
      if (check_all_pairs) {
        pairwise <- list()
        idx <- 1

        for (i in seq_along(effects)) {
          for (j in seq_along(effects)) {
            if (j <= i) next
            T1 <- effects[[i]]$contrasts
            T2 <- effects[[j]]$contrasts
            orth <- das_check_pairwise_orthogonality(C, T1, T2, tol = tol)

            pairwise[[idx]] <- list(
              alpha1 = effects[[i]]$alpha,
              alpha2 = effects[[j]]$alpha,
              is_orthogonal = orth$is_orthogonal,
              max_abs = orth$max_abs
            )
            idx <- idx + 1
          }
        }
      }

      list(
        C = C,
        R = cm$R,
        Kinv = cm$Kinv,
        N = cm$N,
        eig = eigs,
        rank = rankC,
        effects = effects_summary,
        pairwise = pairwise
      )
    }
  }

  compute_J2_distance <- function(D, w = NULL) {
    D <- as.matrix(D)
    n <- nrow(D)
    m <- ncol(D)

    if (is.null(w)) w <- rep(1, m)

    delta_sq_sum <- 0
    for (i in 1:(n - 1)) {
      for (j in (i + 1):n) {
        delta_ij <- sum(w * (D[i, ] == D[j, ]))
        delta_sq_sum <- delta_sq_sum + delta_ij^2
      }
    }

    BalanceCoeff <- delta_sq_sum / choose(n, 2)
    list(J2_Dist = delta_sq_sum, BalanceCoeff = BalanceCoeff)
  }

  compute_J2_optimization <- function(D, w = NULL) {
    D <- as.matrix(D)
    n <- nrow(D)
    m <- ncol(D)

    if (is.null(w)) w <- rep(1, m)

    delta_sq_sum <- 0
    for (i in 1:(n - 1)) {
      for (j in (i + 1):n) {
        delta_ij <- sum(w * (D[i, ] == D[j, ]))
        delta_sq_sum <- delta_sq_sum + delta_ij^2
      }
    }

    BalanceCoeff <- sum(apply(D, 2, function(col) {
      freq <- table(col) / n
      sum((freq - mean(freq))^2)
    }))

    list(J2_Opt = delta_sq_sum, BalanceCoeff = BalanceCoeff)
  }

  compute_J2_lower_bound <- function(D, w = NULL, s_vec = NULL) {
    D <- as.matrix(D)
    n <- nrow(D)
    m <- ncol(D)

    if (is.null(w)) w <- rep(1, m)
    if (is.null(s_vec)) s_vec <- apply(D, 2, function(col) length(unique(col)))

    L_sum <- 0
    for (k in 1:m) {
      Sk <- s_vec[k]
      wk <- w[k]
      nk <- n / Sk
      L_sum <- L_sum + wk^2 * (nk^2 * Sk + nk * (nk - 1) * Sk)
    }

    0.5 * L_sum
  }

  effect_values_on_block <- function(block_treatments, coeffs_mods) {
    trt_mat <- t(sapply(block_treatments, function(trt) {
      as.numeric(strsplit(trt, "")[[1]])
    }))

    vals <- numeric(nrow(trt_mat))
    for (i in seq_len(nrow(trt_mat))) {
      vals[i] <- sum(trt_mat[i, ] * coeffs_mods) %% mod_s
    }
    vals
  }

  is_confounded_from_principal_block <- function(block_treatments, coeffs_mods) {
    vals <- effect_values_on_block(block_treatments, coeffs_mods)
    !all(sort(unique(vals)) == 0:(mod_s - 1))
  }

  decode_treatment <- function(trt_label) {
    t(sapply(trt_label, function(x) as.numeric(unlist(strsplit(x, "")))))
  }

  built <- build_incidence(factor_levels, blocks)
  comp <- compute_Cmatrix(built$N)

  mm <- build_contrast_matrix(built$grids)
  proper <- (max(colSums(built$N)) - min(colSums(built$N))) < 1e-8
  equi <- (max(rowSums(built$N)) - min(rowSums(built$N))) < 1e-8
  conn <- (as.integer(Matrix::rankMatrix(comp$C)[1]) == (nrow(comp$C) - 1))
  balance <- evaluate_balance(comp$C, mm)
  ofs <- check_design_OFS(factor_levels, blocks)

  symmetric_flag <- length(unique(factor_levels)) == 1

  if (!symmetric_flag) {
    conf_table <- data.frame(
      Effect = "Confounding summary currently implemented only for symmetric s-level factorials",
      Confounded = NA_character_,
      stringsAsFactors = FALSE
    )
    theoretical_confounded_total <- NA
    listed_confounded_count <- NA
    conf_check_msg <- "Verification skipped: factor_levels are not all equal."
  } else {
    mod_s <- factor_levels[1]
    nfac <- length(factor_levels)
    principal_block <- blocks[[1]]

    conf_rows <- list()

    for (j in 1:nfac) {
      for (k in 1:(mod_s - 1)) {
        coeffs <- rep(0, nfac)
        coeffs[j] <- k

        eff_name <- paste0("F", j, k)
        conf_flag <- is_confounded_from_principal_block(principal_block, coeffs)

        conf_rows[[length(conf_rows) + 1]] <- data.frame(
          Effect = eff_name,
          Confounded = ifelse(conf_flag, "YES", "NO"),
          stringsAsFactors = FALSE
        )
      }
    }

    factor_pairs <- combn(1:nfac, 2, simplify = FALSE)

    for (pair in factor_pairs) {
      i <- pair[1]
      j <- pair[2]

      for (bcoef in 1:(mod_s - 1)) {
        coeffs <- rep(0, nfac)
        coeffs[i] <- 1
        coeffs[j] <- bcoef

        eff_name <- paste0("F", i, 1, ":F", j, bcoef)
        conf_flag <- is_confounded_from_principal_block(principal_block, coeffs)

        conf_rows[[length(conf_rows) + 1]] <- data.frame(
          Effect = eff_name,
          Confounded = ifelse(conf_flag, "YES", "NO"),
          stringsAsFactors = FALSE
        )
      }
    }

    conf_table <- do.call(rbind, conf_rows)

    b <- length(blocks)
    nr_val <- round(log(b, base = mod_s))
    theoretical_confounded_total <- (mod_s^nr_val - 1) / (mod_s - 1)
    listed_confounded_count <- sum(conf_table$Confounded == "YES", na.rm = TRUE)

    conf_check_msg <- if (listed_confounded_count <= theoretical_confounded_total) {
      paste0(
        "Verified: listed confounded effects = ", listed_confounded_count,
        " <= theoretical total confounded effects = ", theoretical_confounded_total, "."
      )
    } else {
      paste0(
        "Warning: listed confounded effects = ", listed_confounded_count,
        " > theoretical total confounded effects = ", theoretical_confounded_total,
        ". Confounding calculation or listed-effect construction may be incorrect."
      )
    }
  }

  results_list <- lapply(blocks, function(b) {
    Td_block <- decode_treatment(b)
    compute_Hd_DD_mixed(Td_block, q_vec = factor_levels)
  })

  Td_all <- do.call(rbind, lapply(blocks, decode_treatment))
  overall_result <- compute_Hd_DD_mixed(Td_all, q_vec = factor_levels)

  factor_matrix_runs <- do.call(rbind, lapply(blocks, function(bl) decode_treatment(bl)))
  J2_Dist_res <- compute_J2_distance(factor_matrix_runs)
  J2_Opt_res <- compute_J2_optimization(factor_matrix_runs)
  J2_LB_val <- compute_J2_lower_bound(
    factor_matrix_runs,
    w = rep(1, ncol(factor_matrix_runs)),
    s_vec = factor_levels
  )

  J2_eff_dist <- if (!is.null(J2_Dist_res$J2_Dist) && J2_Dist_res$J2_Dist > 0) {
    J2_LB_val / J2_Dist_res$J2_Dist
  } else {
    NA
  }

  J2_eff_opt <- if (!is.null(J2_Opt_res$J2_Opt) && J2_Opt_res$J2_Opt > 0) {
    J2_LB_val / J2_Opt_res$J2_Opt
  } else {
    NA
  }

  mu_vals <- eigen(comp$C, symmetric = TRUE, only.values = TRUE)$values
  tol_eig <- 1e-8
  mu_nonzero <- mu_vals[mu_vals > tol_eig]

  deltas <- sort(mu_nonzero, decreasing = FALSE)

  p_values <- c(2, 1, 0.5)
  phi_p_values <- sapply(p_values, function(p) {
    if (any(deltas <= 0)) return(Inf)
    mean(deltas^(-p))
  })
  names(phi_p_values) <- paste0("phi_p (p=", p_values, ")")

  trC2 <- sum(mu_nonzero^2)
  equal_val <- mean(mu_nonzero)
  euclid_dist <- sqrt(sum((mu_nonzero - equal_val)^2))

  is_completely_symmetric <- function(C, tol = 1e-8) {
    diag_vals <- diag(C)
    off_vals <- C[upper.tri(C)]
    if (max(abs(diag_vals - mean(diag_vals))) > tol) return(FALSE)
    if (max(abs(off_vals - mean(off_vals))) > tol) return(FALSE)
    TRUE
  }

  sym_flag <- is_completely_symmetric(comp$C)
  uni_msg <- if (sym_flag) {
    "Design meets symmetry condition -> candidate universally optimal"
  } else {
    "Symmetry condition not met -> unlikely universally optimal by Kiefer's sufficient condition"
  }

  s_vec <- factor_levels
  Nmat <- built$N

  das_info <- if (ncol(Nmat) == 0 || nrow(Nmat) == 0) {
    list(
      available = FALSE,
      error = "Skipping Das diagnostics: empty incidence matrix.",
      rank = NA_integer_,
      eigenvalues = NULL,
      effects = NULL,
      pairwise = NULL
    )
  } else {
    tmp <- tryCatch(
      {
        res <- das_analyze_design(s_vec, Nmat, check_all_pairs = FALSE, tol = 1e-6)
        list(
          available = TRUE,
          error = NULL,
          rank = res$rank,
          eigenvalues = res$eig,
          effects = res$effects,
          pairwise = res$pairwise
        )
      },
      error = function(e) {
        list(
          available = FALSE,
          error = conditionMessage(e),
          rank = NA_integer_,
          eigenvalues = NULL,
          effects = NULL,
          pairwise = NULL
        )
      }
    )
    tmp
  }

  block_DDs <- sapply(results_list, function(x) x$DD)

  out <- list(
    factorial_experiment = factor_levels,
    num_treatments = nrow(built$N),
    num_blocks = ncol(built$N),
    incidence = built$N,
    C_matrix = comp$C,
    proper = proper,
    equireplicate = equi,
    connected = conn,
    ofs = ofs,
    balance = balance,
    das = das_info,
    confounding_table = conf_table,
    theoretical_confounded_total = theoretical_confounded_total,
    listed_confounded_count = listed_confounded_count,
    confounding_verification_message = conf_check_msg,
    hamming_distance_matrix = overall_result$Hd_total,
    block_discrete_discrepancies = block_DDs,
    average_DD = mean(block_DDs),
    overall_DD = overall_result$DD,
    J2_distance = J2_Dist_res,
    J2_optimization = J2_Opt_res,
    J2_lower_bound = J2_LB_val,
    J2_efficiency_distance = J2_eff_dist,
    J2_efficiency_optimization = J2_eff_opt,
    phi_p_values = phi_p_values,
    S_criterion = trC2,
    distance_equal_eigen = euclid_dist,
    universal_optimality_message = uni_msg
  )

  class(out) <- "lfebd3_analysis"
  invisible(out)
}
#' Print an lfebd3 analysis object
#'
#' Displays the formatted report for an object returned by [FactChar()].
#'
#' @param x An object of class `"lfebd3_analysis"`.
#' @param ... Further arguments passed to or from other methods.
#'
#' @return Invisibly returns `x`.
#' @export
print.lfebd3_analysis <- function(x, ...) {

  cat("\n====================== DESIGN PROPERTIES ======================\n")
  cat("Factorial Experiment:", paste(x$factorial_experiment, collapse = " x "), "\n")
  cat("Number of Treatments (v):", x$num_treatments, "\n")
  cat("Number of Blocks (b):", x$num_blocks, "\n")
  cat("Proper Design:", x$proper, "\n")
  cat("Equireplicate:", x$equireplicate, "\n")
  cat("Connected:", x$connected, "\n\n")
  cat(
    "OFS (Orthogonal Factorial Structure):", x$ofs$OFS,
    "(mean |correlation| =", round(x$ofs$mean_corr, 3), ")\n"
  )

  if (isTRUE(x$das$available)) {
    cat("rank(C) =", x$das$rank, "\n")
    cat("Eigenvalues of C:\n")
    print(round(x$das$eigenvalues, 6))

    cat("\n================ EFFECTS SUMMARY (All Effects) ================\n")
    cat(sprintf(
      "%-10s %-10s %-10s %-12s %-18s %-15s\n",
      "alpha", "DF", "estimable", "balanced", "balance_variance", "max_offdiag(OFS)"
    ))

    for (ef in x$das$effects) {
      cat(sprintf(
        "%-10s %-10d %-10s %-12s %-18.6g %-15.3g\n",
        paste(ef$alpha, collapse = ""),
        ef$f_alpha,
        ef$estimable,
        ef$balanced,
        ef$balance_scalar,
        ef$max_offdiag
      ))
    }

    cat("==============================================================\n")
  } else if (!is.null(x$das$error)) {
    cat("Das diagnostics:", x$das$error, "\n")
  }

  cat("\n=== Confounding Summary ===\n")
  print(x$confounding_table, row.names = FALSE)

  cat("\nTheoretical total number of confounded effects =", x$theoretical_confounded_total, "\n")
  cat("Number of listed confounded main effects / two-factor interactions =", x$listed_confounded_count, "\n")
  cat(x$confounding_verification_message, "\n")

  if (!all(is.na(x$confounding_table$Confounded))) {
    if (all(x$confounding_table$Confounded == "NO")) {
      cat("\nNo listed main effects or two-factor interactions are confounded with blocks.\n")
    } else {
      cat("\nSome listed main effects or two-factor interactions are confounded with blocks.\n")
    }
  }

  cat("\nHamming Distance Matrix of Combined Design:\n")
  print(x$hamming_distance_matrix)

  cat("\n=========================== Discrete Discrepancy Summary ===========================\n")
  cat("Average DD =", round(x$average_DD, 6), "\n")
  cat("Overall DD =", round(x$overall_DD, 6), "\n")

  cat("\n===================== ADVANCED OPTIMALITY & ABERRATION =====================\n")
  cat(sprintf(
    "J2 (Distance Function): %g   | Balance Coeff (Form II): %g\n",
    x$J2_distance$J2_Dist, x$J2_distance$BalanceCoeff
  ))
  cat(sprintf(
    "   -> J2-efficiency (L(n)/J2) = %g\n",
    x$J2_efficiency_distance
  ))
  cat(sprintf(
    "J2 (Optimization Procedure): %g   | Balance Coeff (Form I): %g\n",
    x$J2_optimization$J2_Opt, x$J2_optimization$BalanceCoeff
  ))
  cat(sprintf(
    "   -> J2-efficiency (L(n)/J2) = %g\n",
    x$J2_efficiency_optimization
  ))
  cat(sprintf("Lower Bound of J2 (Balanced Design): %g\n", x$J2_lower_bound))
  cat("Phi_p values:\n")
  print(x$phi_p_values)
  cat("\nS-criterion: trace(C^2) =", x$S_criterion, "\n")
  cat("Distance from equal eigenvalues =", x$distance_equal_eigen, "\n")
  cat("\nUniversal optimality check:", x$universal_optimality_message, "\n")

  invisible(x)
}
# =========================================================
# PART 4: INTEGRATED GENERATE + ANALYZE WRAPPER
# =========================================================

#' Generate and analyze an LFBD in one call
#'
#' Wrapper that generates a complete, fractional, or confounded LFBD and then,
#' optionally, analyzes its design characteristics.
#'
#' @param type Character string specifying the generator to use. Must be one of
#'   `"lfbd"`, `"lfbd.fr"`, or `"lfbd.cf.full"`.
#' @param factor_levels Integer vector giving the number of levels for each
#'   factor.
#' @param n Integer. Number of factors used by the generator.
#' @param c Optional integer degree of fractionation for `type = "lfbd.fr"`.
#' @param r Optional integer controlling principal block size for
#'   `type = "lfbd.cf.full"`.
#' @param block_size Optional block size used when converting run-ordered
#'   designs into blocks.
#' @param show_design Logical; if `TRUE`, print the generated design.
#' @param run_analysis Logical; if `TRUE`, call [FactChar()] on the derived
#'   blocks.
#'
#' @return Invisibly returns a list with the selected design type, generated
#'   design object, derived block list, and analysis output.
#'
#' @details
#' This wrapper uses internal helper functions to convert generated designs
#' into block lists and to print the generated design before analysis.
#'
#' @seealso [lfbd()], [lfbd.fr()], [lfbd.cf.full()], [FactChar()]
#' @export
lfbd_analyze <- function(type = c("lfbd", "lfbd.fr", "lfbd.cf.full"),
                         factor_levels,
                         n,
                         c = NULL,
                         r = NULL,
                         block_size = NULL,
                         show_design = TRUE,
                         run_analysis = TRUE) {

  type <- match.arg(type)

  design_df <- NULL
  blocks <- NULL

  if (type == "lfbd") {
    design_df <- lfbd(n)

    if (is.null(block_size)) {
      stop("For type = 'lfbd', please provide block_size.")
    }

    blocks <- as_blocks_from_runs(design_df, block_size = block_size)

  } else if (type == "lfbd.fr") {
    if (is.null(c)) {
      stop("For type = 'lfbd.fr', please provide c.")
    }

    design_df <- lfbd.fr(n, c)

    if (is.null(block_size)) {
      stop("For type = 'lfbd.fr', please provide block_size.")
    }

    blocks <- as_blocks_from_runs(design_df, block_size = block_size)

  } else if (type == "lfbd.cf.full") {
    if (is.null(r)) {
      stop("For type = 'lfbd.cf.full', please provide r.")
    }

    design_df <- lfbd.cf.full(n, r)
    blocks <- as_blocks_from_cf_full(design_df)
  }

  if (show_design) {
    print_generated_design(design_df)
  }

  analysis_result <- NULL
  if (run_analysis) {
    cat("\n================ DESIGN CHARACTERISTICS ================\n")
    analysis_result <- FactChar(factor_levels = factor_levels, blocks = blocks)
    cat("========================================================\n")
  }

  invisible(list(
    type = type,
    generated_design = design_df,
    blocks = blocks,
    analysis = analysis_result
  ))
}
