#' MFRCD: Mixed-Level Factorial Row-Column Designs
#'
#' Functions for constructing, checking, analyzing, and repairing mixed-level
#' factorial row-column designs. The main entry points are [mfrcd()],
#' [verify_mfrcd()], [analyse_rcd()], and [mfrcd_check_repair()].
#'
#' @keywords internal
#' @importFrom stats contr.sum model.matrix setNames terms
#' @importFrom utils combn flush.console head tail txtProgressBar setTxtProgressBar
"_PACKAGE"
#' Greatest common divisor of two integers
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param a An integer value.
#' @param b An integer value.
#'
#' @return Internal helper return value.
#' @references
#' Gopinath, P. P., Parsad, R. and Mandal, B. N. (2018).
#' Construction of optimal row-column designs for factorial experiments.
#' \emph{Communications in Statistics - Theory and Methods}.
#' doi:10.1080/03610926.2017.1376091
#' @keywords internal
#' @noRd
gcd_int <- function(a, b) {
  a <- abs(as.integer(a))
  b <- abs(as.integer(b))
  while (b != 0) {
    temp <- b
    b <- a %% b
    a <- temp
  }
  a
}

#' Convert an integer to mixed-radix digits
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#' @param bases Integer vector of radix bases.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
mixed_radix_digits <- function(x, bases) {
  digits <- integer(length(bases))

  for (i in rev(seq_along(bases))) {
    digits[i] <- x %% bases[i]
    x <- x %/% bases[i]
  }

  digits
}

#' Format two design component matrices as treatment labels
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param D1 Matrix for the first factor component.
#' @param D2 Matrix for the second factor component.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
format_design <- function(D1, D2, sep = "") {
  out <- matrix(
    paste0(as.vector(D1), sep, as.vector(D2)),
    nrow = nrow(D1),
    ncol = ncol(D1)
  )
  rownames(out) <- paste0("R", seq_len(nrow(out)))
  colnames(out) <- paste0("C", seq_len(ncol(out)))
  out
}

#' Create a numeric row-column design array
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param D1 Matrix for the first factor component.
#' @param D2 Matrix for the second factor component.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
make_numeric_array <- function(D1, D2) {
  arr <- array(
    NA_integer_,
    dim = c(nrow(D1), ncol(D1), 2),
    dimnames = list(
      paste0("R", seq_len(nrow(D1))),
      paste0("C", seq_len(ncol(D1))),
      c("F1", "F2")
    )
  )
  arr[, , 1] <- D1
  arr[, , 2] <- D2
  arr
}

#' Construct a two-factor row-column design using Method 1
#'
#' Construct a two-factor row-column design using Method 1.
#'
#' @param s1 Number of levels for the first factor or factor group.
#' @param s2 Number of levels for the second factor or factor group.
#' @param f Common factor used by Method 1.
#' @param sep Character separator used in treatment labels.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' ex <- rc_method1(2, 4)
#' stopifnot(is.matrix(ex$design))
rc_method1 <- function(s1, s2, f = NULL, sep = "") {
  if (s1 <= 1 || s2 <= 1) stop("s1 and s2 must both be greater than 1.")
  if (is.null(f)) f <- gcd_int(s1, s2)
  if (f <= 1) stop("Method 1 requires s1 and s2 to have a common factor greater than 1.")
  if (s1 %% f != 0 || s2 %% f != 0) stop("The supplied f must divide both s1 and s2.")

  g1 <- s1 / f
  g2 <- s2 / f
  p <- g1 * g2 * f
  q <- p
  r <- g1 * g2

  theta <- rep(0:(s1 - 1), each = g2)
  D1 <- sapply(0:(q - 1), function(alpha) (theta + alpha) %% s1)
  D1 <- matrix(D1, nrow = p, ncol = q)

  make_B <- function(u) {
    outer(0:(s2 - 1), 0:(q - 1), function(i, j) (i + u + j) %% s2)
  }
  D2 <- do.call(rbind, lapply(0:(g1 - 1), make_B))

  list(
    method = "Method 1",
    parameters = data.frame(s1 = s1, s2 = s2, f = f, g1 = g1, g2 = g2,
                            rows = p, columns = q, replications = r),
    D1 = D1,
    D2 = D2,
    design = format_design(D1, D2, sep = sep),
    numeric_design = make_numeric_array(D1, D2)
  )
}

#' Right-shift a vector
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#' @param k Number of positions to shift.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
right_shift <- function(x, k = 1) {
  n <- length(x)
  k <- k %% n
  if (k == 0) return(x)
  c(tail(x, k), head(x, n - k))
}

#' Construct a two-factor row-column design using Method 2
#'
#' Construct a two-factor row-column design using Method 2.
#'
#' @param s1 Number of levels for the first factor or factor group.
#' @param s2 Number of levels for the second factor or factor group.
#' @param sep Character separator used in treatment labels.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' ex <- rc_method2(2, 4)
#' stopifnot(is.matrix(ex$design))
rc_method2 <- function(s1, s2, sep = "") {
  if (s1 <= 1 || s2 <= 1) stop("s1 and s2 must both be greater than 1.")
  if (s2 %% s1 != 0) stop("Method 2 requires s2 to be a multiple of s1.")

  g2 <- s2 / s1
  p <- s2
  q <- s2
  r <- g2

  theta <- rep(0:(s1 - 1), each = g2)

  D1 <- sapply(
    0:(q - 1),
    function(alpha) (theta + alpha) %% s1
  )
  D1 <- matrix(D1, nrow = p, ncol = q)

  D2 <- outer(
    0:(p - 1),
    0:(q - 1),
    function(i, j) (i + j) %% s2
  )

  storage.mode(D1) <- "integer"
  storage.mode(D2) <- "integer"

  list(
    method = "Method 2",
    parameters = data.frame(
      s1 = s1,
      s2 = s2,
      g2 = g2,
      rows = p,
      columns = q,
      replications = r
    ),
    D1 = D1,
    D2 = D2,
    design = format_design(D1, D2, sep = sep),
    numeric_design = make_numeric_array(D1, D2)
  )
}

#' Construct a mixed-level factorial row-column design
#'
#' Construct a mixed-level factorial row-column design.
#'
#' @param levels Integer vector of factor levels.
#' @param sep Character separator used in treatment labels.
#' @param details Logical; if TRUE, return construction details.
#' @param group1 Optional integer vector of factor indices in the first group.
#' @param group2 Optional integer vector of factor indices in the second group.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' ex <- rc_factorial_n(c(2, 2))
#' stopifnot(is.matrix(ex))
rc_factorial_n <- function(levels,
                           sep = "",
                           details = FALSE,
                           group1 = NULL,
                           group2 = NULL) {

  if (length(levels) < 2) {
    stop("At least two factors are required.")
  }

  if (any(levels <= 1)) {
    stop("All factor levels must be greater than 1.")
  }

  levels <- as.integer(levels)
  n_factors <- length(levels)
  total_treatments <- prod(levels)

  method_possible <- function(s1, s2) {
    if (s2 %% s1 == 0) {
      return("Method 2")
    }

    if (gcd_int(s1, s2) > 1) {
      return("Method 1")
    }

    NA_character_
  }

  candidate_size <- function(s1, s2, method) {
    if (method == "Method 2") {
      return(s2)
    }

    if (method == "Method 1") {
      f <- gcd_int(s1, s2)
      return((s1 / f) * (s2 / f) * f)
    }

    Inf
  }

  is_natural_split <- function(g1, g2) {
    for (split in 1:(n_factors - 1)) {
      if (identical(g1, 1:split) &&
          identical(g2, (split + 1):n_factors)) {
        return(TRUE)
      }
    }
    FALSE
  }

  candidates <- list()

  add_candidate <- function(g1, g2, natural = FALSE) {

    s1 <- prod(levels[g1])
    s2 <- prod(levels[g2])

    method <- method_possible(s1, s2)

    if (!is.na(method)) {
      p <- candidate_size(s1, s2, method)

      candidates[[length(candidates) + 1]] <<- list(
        group1 = g1,
        group2 = g2,
        s1 = s1,
        s2 = s2,
        method = method,
        rows = p,
        columns = p,
        replications = p * p / total_treatments,
        natural = natural
      )
    }
  }

  if (!is.null(group1)) {

    group1 <- as.integer(group1)

    if (is.null(group2)) {
      group2 <- setdiff(seq_len(n_factors), group1)
    } else {
      group2 <- as.integer(group2)
    }

    if (length(intersect(group1, group2)) > 0) {
      stop("group1 and group2 must not overlap.")
    }

    if (!setequal(c(group1, group2), seq_len(n_factors))) {
      stop("group1 and group2 together must contain all factor indices.")
    }

    # When the user supplies group1/group2, keep that orientation fixed.
    # In particular, for n > 2 automatic square construction we want
    # group1 = first factor and group2 = all remaining factors.
    add_candidate(group1, group2, natural = is_natural_split(group1, group2))
  }

  if (is.null(group1)) {

    all_indices <- seq_len(n_factors)
    rest_indices <- 2:n_factors

    for (m in 0:length(rest_indices)) {

      subsets <- if (m == 0) {
        list(integer(0))
      } else {
        combn(rest_indices, m, simplify = FALSE)
      }

      for (sub in subsets) {

        gA <- c(1, sub)
        gB <- setdiff(all_indices, gA)

        if (length(gB) == 0) next

        natural_AB <- is_natural_split(gA, gB)
        natural_BA <- is_natural_split(gB, gA)

        add_candidate(gA, gB, natural = natural_AB)
        add_candidate(gB, gA, natural = natural_BA)
      }
    }
  }

  if (length(candidates) == 0) {
    stop(
      paste0(
        "No valid grouping found for levels = c(",
        paste(levels, collapse = ", "),
        "). These methods require two super-factors such that either ",
        "they have a common factor, or the second is a multiple of the first."
      )
    )
  }

  score_candidate <- function(x) {
    method_score <- ifelse(x$method == "Method 2", 0, 1)
    natural_score <- ifelse(x$natural, 0, 1)
    balance_score <- abs(length(x$group1) - length(x$group2))

    c(
      x$rows,
      method_score,
      natural_score,
      balance_score
    )
  }

  scores <- do.call(rbind, lapply(candidates, score_candidate))
  best_id <- order(scores[, 1], scores[, 2], scores[, 3], scores[, 4])[1]
  best <- candidates[[best_id]]

  if (best$method == "Method 2") {
    obj <- rc_method2(s1 = best$s1, s2 = best$s2, sep = sep)
  } else {
    obj <- rc_method1(s1 = best$s1, s2 = best$s2, sep = sep)
  }

  arr <- obj$numeric_design
  nr <- dim(arr)[1]
  nc <- dim(arr)[2]

  expanded_numeric <- array(
    NA_integer_,
    dim = c(nr, nc, n_factors),
    dimnames = list(
      paste0("R", seq_len(nr)),
      paste0("C", seq_len(nc)),
      paste0("F", seq_len(n_factors))
    )
  )

  expanded_design <- matrix("", nrow = nr, ncol = nc)

  for (i in seq_len(nr)) {
    for (j in seq_len(nc)) {

      value1 <- arr[i, j, 1]
      value2 <- arr[i, j, 2]

      digits1 <- mixed_radix_digits(value1, levels[best$group1])
      digits2 <- mixed_radix_digits(value2, levels[best$group2])

      full_value <- integer(n_factors)
      full_value[best$group1] <- digits1
      full_value[best$group2] <- digits2

      expanded_numeric[i, j, ] <- full_value
      expanded_design[i, j] <- paste0(full_value, collapse = sep)
    }
  }

  rownames(expanded_design) <- paste0("R", seq_len(nr))
  colnames(expanded_design) <- paste0("C", seq_len(nc))

  attr(expanded_design, "numeric_design") <- expanded_numeric
  attr(expanded_design, "original_levels") <- levels

  if (details) {
    return(list(
      design = expanded_design,
      numeric_design = expanded_numeric,
      chosen_method = best$method,
      original_levels = levels,
      superfactor_1 = best$group1,
      superfactor_2 = best$group2,
      superfactor_levels = c(best$s1, best$s2),
      rows = nr,
      columns = nc,
      replications = best$replications,
      all_candidates = candidates,
      two_factor_object = obj
    ))
  }

  return(expanded_design)
}

#' Check basic row-column factorial design properties
#'
#' Check basic row-column factorial design properties.
#'
#' @param D A design object or design matrix.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' ex <- rc_factorial_n(c(2, 2))
#' chk <- check_rc_factorial_n(ex)
#' stopifnot(is.list(chk))
check_rc_factorial_n <- function(D) {

  arr <- attr(D, "numeric_design")
  levels <- attr(D, "original_levels")

  if (is.null(arr) || is.null(levels)) {
    stop("The design must be generated by rc_factorial_n().")
  }

  n_factors <- length(levels)

  observed <- apply(arr, c(1, 2), function(x) paste(x, collapse = ","))
  observed_vec <- as.vector(observed)

  level_list <- lapply(levels, function(s) 0:(s - 1))
  all_treatments <- do.call(expand.grid, level_list)
  required_vec <- apply(all_treatments, 1, function(x) paste(x, collapse = ","))

  freq <- table(observed_vec)

  list(
    levels = levels,
    number_of_factors = n_factors,
    rows = nrow(D),
    columns = ncol(D),
    total_positions = length(observed_vec),
    total_treatment_combinations = prod(levels),
    replications = length(observed_vec) / prod(levels),
    number_of_unique_treatments = length(unique(observed_vec)),
    full_treatment_set_present = setequal(observed_vec, required_vec),
    all_frequencies_equal = length(unique(as.integer(freq))) == 1,
    treatment_frequencies = sort(freq)
  )
}

#' Generate all factorial treatment combinations
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
all_treatment_combinations <- function(levels) {

  levels <- as.integer(levels)
  n_factors <- length(levels)

  grid_rev <- do.call(
    expand.grid,
    lapply(rev(levels), function(s) 0:(s - 1))
  )

  grid <- grid_rev[, rev(seq_len(n_factors)), drop = FALSE]
  colnames(grid) <- paste0("F", seq_len(n_factors))

  as.matrix(grid)
}

#' Create a treatment label from factor levels
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
treatment_label <- function(x, sep = "") {
  paste0(x, collapse = sep)
}

#' Add two treatment vectors modulo factor levels
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#' @param y An object.
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
mod_add_treatment <- function(x, y, levels) {
  (as.integer(x) + as.integer(y)) %% as.integer(levels)
}

#' Parse a treatment label into numeric factor levels
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param label Treatment label.
#' @param n_factors Number of factors.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
parse_treatment_label <- function(label, n_factors) {

  label <- as.character(label)

  if (grepl("[,[:space:]|;:-]", label)) {
    parts <- unlist(strsplit(label, "[,[:space:]|;:-]+"))
    parts <- parts[parts != ""]
    return(as.integer(parts))
  }

  if (nchar(label) == n_factors) {
    return(as.integer(strsplit(label, "")[[1]]))
  }

  stop(
    paste0(
      "Cannot parse treatment label: ", label,
      ". For multi-digit levels, supply principal_block as a numeric matrix."
    )
  )
}

#' Convert a principal block to a numeric matrix
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param principal_block Optional principal block of treatment labels.
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
principal_block_to_matrix <- function(principal_block, levels) {

  n_factors <- length(levels)

  if (is.matrix(principal_block) || is.data.frame(principal_block)) {
    pb <- as.matrix(principal_block)
    storage.mode(pb) <- "integer"

    if (ncol(pb) != n_factors) {
      stop("principal_block must have one column per factor.")
    }

    return(pb)
  }

  if (is.character(principal_block)) {
    pb <- do.call(
      rbind,
      lapply(principal_block, parse_treatment_label, n_factors = n_factors)
    )
    storage.mode(pb) <- "integer"
    return(pb)
  }

  stop("principal_block must be a character vector, matrix, or data.frame.")
}

#' Move the zero treatment to the first position
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param pb Function argument.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
put_zero_treatment_first <- function(pb) {

  zero_row <- which(rowSums(abs(pb)) == 0)

  if (length(zero_row) == 0) {
    warning("Zero treatment is not present in the principal block.")
    return(pb)
  }

  zero_row <- zero_row[1]

  if (zero_row == 1) {
    return(pb)
  }

  pb[c(zero_row, setdiff(seq_len(nrow(pb)), zero_row)), , drop = FALSE]
}

#' Compute a simple block balance score
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param block Vector of treatment labels in one block.
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
block_balance_score <- function(block, levels) {

  k <- nrow(block)
  score <- 0

  for (f in seq_along(levels)) {
    counts <- tabulate(block[, f] + 1, nbins = levels[f])
    expected <- k / levels[f]
    score <- score + sum((counts - expected)^2)
  }

  score
}

#' Extract a principal block using mixedfact
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param levels Integer vector of factor levels.
#' @param block_size Block size used in the construction.
#' @param mixedfact_method Method passed to mixedfact when that route is used.
#' @param choose_block Rule for choosing a block when several are available.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
extract_principal_block_mixedfact <- function(levels,
                                              block_size,
                                              mixedfact_method = "auto",
                                              choose_block = "best") {

  choose_block <- match.arg(choose_block, c("best", "first"))

  if (!requireNamespace("mixedfact", quietly = TRUE)) {
    stop(
      paste0(
        "Package 'mixedfact' is required. Install it using:\n",
        "install.packages('mixedfact')"
      )
    )
  }

  out <- mixedfact::mixedfact(
    levels_vec = levels,
    block_size = block_size,
    method = mixedfact_method,
    verbose = FALSE
  )

  if (!is.null(out$blocks_numeric)) {

    blocks <- lapply(out$blocks_numeric, function(x) {
      x <- as.matrix(x)
      storage.mode(x) <- "integer"
      x
    })

  } else if (!is.null(out$blocks_labels)) {

    blocks <- lapply(out$blocks_labels, function(x) {
      principal_block_to_matrix(x, levels = levels)
    })

  } else {
    stop("Could not find blocks_numeric or blocks_labels in mixedfact output.")
  }

  if (choose_block == "first") {
    selected <- blocks[[1]]
  } else {
    scores <- sapply(blocks, block_balance_score, levels = levels)
    selected <- blocks[[which.min(scores)]]
  }

  selected <- put_zero_treatment_first(selected)

  list(
    principal_block = selected,
    mixedfact_output = out,
    all_blocks = blocks
  )
}

#' Construct a row-column design from a principal block
#'
#' Construct a row-column design from a principal block.
#'
#' @param levels Integer vector of factor levels.
#' @param block_size Block size used in the construction.
#' @param principal_block Optional principal block of treatment labels.
#' @param use_mixedfact Logical; if TRUE, allow the mixedfact-based construction route.
#' @param mixedfact_method Method passed to mixedfact when that route is used.
#' @param choose_block Rule for choosing a block when several are available.
#' @param sep Character separator used in treatment labels.
#' @param details Logical; if TRUE, return construction details.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' pb <- matrix(c(0, 0, 0, 1), ncol = 2, byrow = TRUE)
#' ex <- rc_from_principal_block(c(2, 2), block_size = 2, principal_block = pb, details = TRUE)
#' stopifnot(is.matrix(ex$design))
rc_from_principal_block <- function(levels,
                                    block_size,
                                    principal_block = NULL,
                                    use_mixedfact = TRUE,
                                    mixedfact_method = "auto",
                                    choose_block = "best",
                                    sep = "",
                                    details = FALSE) {

  levels <- as.integer(levels)

  if (any(levels <= 1)) {
    stop("All factor levels must be greater than 1.")
  }

  total_treatments <- prod(levels)

  if (block_size <= 1) {
    stop("block_size must be greater than 1.")
  }

  mixedfact_output <- NULL
  all_blocks <- NULL

  if (is.null(principal_block)) {

    if (!use_mixedfact) {
      stop("Either supply principal_block or set use_mixedfact = TRUE.")
    }

    mf <- extract_principal_block_mixedfact(
      levels = levels,
      block_size = block_size,
      mixedfact_method = mixedfact_method,
      choose_block = choose_block
    )

    principal_column <- mf$principal_block
    mixedfact_output <- mf$mixedfact_output
    all_blocks <- mf$all_blocks

  } else {

    principal_column <- principal_block_to_matrix(
      principal_block = principal_block,
      levels = levels
    )

    principal_column <- put_zero_treatment_first(principal_column)
  }

  if (nrow(principal_column) != block_size) {
    stop("Number of treatments in principal_block must equal block_size.")
  }

  principal_row <- all_treatment_combinations(levels)

  nr <- block_size
  nc <- total_treatments
  nf <- length(levels)

  arr <- array(
    NA_integer_,
    dim = c(nr, nc, nf),
    dimnames = list(
      paste0("R", seq_len(nr)),
      paste0("C", seq_len(nc)),
      paste0("F", seq_len(nf))
    )
  )

  design <- matrix("", nrow = nr, ncol = nc)

  for (i in seq_len(nr)) {
    for (j in seq_len(nc)) {

      trt <- mod_add_treatment(
        x = principal_column[i, ],
        y = principal_row[j, ],
        levels = levels
      )

      arr[i, j, ] <- trt
      design[i, j] <- treatment_label(trt, sep = sep)
    }
  }

  rownames(design) <- paste0("R", seq_len(nr))
  colnames(design) <- paste0("C", seq_len(nc))

  observed <- as.vector(design)
  treatment_freq <- sort(table(observed))

  balance <- check_row_column_balance(arr, levels)

  diagnostics <- list(
    levels = levels,
    block_size = block_size,
    rows = nr,
    columns = nc,
    total_runs = nr * nc,
    total_treatments = total_treatments,
    replications_per_treatment = nr,
    number_unique_treatments = length(unique(observed)),
    all_treatments_present = length(unique(observed)) == total_treatments,
    all_treatment_frequencies_equal = length(unique(as.integer(treatment_freq))) == 1,
    treatment_frequencies = treatment_freq,
    row_balanced_exact = balance$row_balanced_exact,
    column_balanced_as_possible = balance$column_balanced_as_possible,
    row_balance = balance$row_balance,
    column_balance = balance$column_balance
  )

  if (details) {
    return(list(
      design = design,
      numeric_design = arr,
      principal_column = principal_column,
      principal_row = principal_row,
      diagnostics = diagnostics,
      mixedfact_output = mixedfact_output,
      all_blocks = all_blocks
    ))
  }

  design
}

#' Compute a Moore-Penrose inverse by SVD
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param A Numeric matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
svd_ginv <- function(A, tol = sqrt(.Machine$double.eps)) {
  s <- svd(A)
  if (length(s$d) == 0) return(t(A))
  positive <- s$d > tol * max(s$d)
  if (!any(positive)) {
    return(matrix(0, ncol = nrow(A), nrow = ncol(A)))
  }
  s$v[, positive, drop = FALSE] %*%
    diag(1 / s$d[positive], nrow = sum(positive)) %*%
    t(s$u[, positive, drop = FALSE])
}

#' Compute numerical matrix rank
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param A Numeric matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
matrix_rank_tol <- function(A, tol = 1e-8) {
  d <- svd(A, nu = 0, nv = 0)$d
  if (length(d) == 0) return(0L)
  sum(d > tol * max(1, max(d)))
}

#' Symmetrize a square matrix
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param A Numeric matrix.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
symmetrize_matrix <- function(A) {
  (A + t(A)) / 2
}

#' Convert treatment-level rows to treatment indices
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param trt_mat Function argument.
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
treatment_index_from_matrix <- function(trt_mat, levels) {
  levels <- as.integer(levels)
  nf <- length(levels)
  mult <- integer(nf)
  for (i in seq_len(nf)) {
    if (i == nf) {
      mult[i] <- 1L
    } else {
      mult[i] <- prod(levels[(i + 1):nf])
    }
  }
  as.integer(1 + trt_mat %*% mult)
}

#' Convert treatment labels to a numeric array
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param D A design object or design matrix.
#' @param levels Integer vector of factor levels.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
labels_to_numeric_array <- function(D, levels, sep = "") {
  levels <- as.integer(levels)
  nf <- length(levels)
  nr <- nrow(D)
  nc <- ncol(D)
  arr <- array(
    NA_integer_,
    dim = c(nr, nc, nf),
    dimnames = list(
      rownames(D),
      colnames(D),
      paste0("F", seq_len(nf))
    )
  )
  for (i in seq_len(nr)) {
    for (j in seq_len(nc)) {
      lab <- as.character(D[i, j])
      if (nzchar(sep)) {
        parts <- unlist(strsplit(lab, sep, fixed = TRUE))
        parts <- parts[parts != ""]
      } else {
        parts <- strsplit(lab, "")[[1]]
      }
      if (length(parts) != nf) {
        stop("Cannot parse treatment labels. Use details = TRUE in mfrcd(), or provide a numeric design.")
      }
      arr[i, j, ] <- as.integer(parts)
    }
  }
  arr
}

#' Extract a numeric design array
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#' @param levels Integer vector of factor levels.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
extract_numeric_design <- function(x, levels = NULL, sep = "") {
  if (is.list(x) && !is.null(x$numeric_design)) {
    arr <- x$numeric_design
    lev <- levels
    if (is.null(lev) && !is.null(x$original_levels)) lev <- x$original_levels
    if (is.null(lev) && !is.null(x$diagnostics$levels)) lev <- x$diagnostics$levels
    if (is.null(lev)) {
      stop("levels could not be found. Supply levels explicitly.")
    }
    return(list(arr = arr, levels = as.integer(lev)))
  }
  if (is.array(x) && length(dim(x)) == 3) {
    if (is.null(levels)) {
      stop("Supply levels when x is a numeric array.")
    }
    return(list(arr = x, levels = as.integer(levels)))
  }
  if (is.matrix(x) || is.data.frame(x)) {
    if (is.null(levels)) {
      stop("Supply levels when verifying a printed design matrix.")
    }
    return(list(arr = labels_to_numeric_array(as.matrix(x), levels, sep), levels = as.integer(levels)))
  }
  stop("x must be a details list from mfrcd(), a 3D numeric array, or a design matrix.")
}

#' Construct sum-to-zero contrast basis for one factor
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param s Number of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
factor_contrast_basis <- function(s) {
  s <- as.integer(s)
  list(
    mean = matrix(rep(1 / sqrt(s), s), ncol = 1),
    contrast = qr.Q(qr(stats::contr.helmert(s)))
  )
}

#' Kronecker product of a list of matrices
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param mats List of matrices.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
kronecker_reduce <- function(mats) {
  Reduce(function(a, b) kronecker(a, b), mats)
}

#' Construct factorial effect bases
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param levels Integer vector of factor levels.
#' @param max_order Maximum factorial effect order to include.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
factorial_effect_bases <- function(levels, max_order = NULL) {
  levels <- as.integer(levels)
  nf <- length(levels)
  if (is.null(max_order)) max_order <- nf
  fb <- lapply(levels, factor_contrast_basis)
  out <- list()
  for (ord in seq_len(max_order)) {
    subsets <- combn(seq_len(nf), ord, simplify = FALSE)
    for (S in subsets) {
      mats <- lapply(seq_len(nf), function(j) {
        if (j %in% S) fb[[j]]$contrast else fb[[j]]$mean
      })
      Q <- kronecker_reduce(mats)
      effect_name <- paste0("F", S, collapse = ":")
      out[[effect_name]] <- list(
        factors = S,
        order = ord,
        df = ncol(Q),
        basis = Q
      )
    }
  }
  out
}

#' Compute row-column information matrices
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param arr Numeric design array.
#' @param levels Integer vector of factor levels.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
make_row_column_information <- function(arr, levels, tol = 1e-8) {
  levels <- as.integer(levels)
  nr <- dim(arr)[1]
  nc <- dim(arr)[2]
  nf <- length(levels)
  v <- prod(levels)
  N <- nr * nc
  trt_mat <- matrix(NA_integer_, nrow = N, ncol = nf)
  idx <- 1L
  for (j in seq_len(nc)) {
    for (i in seq_len(nr)) {
      trt_mat[idx, ] <- arr[i, j, ]
      idx <- idx + 1L
    }
  }
  trt_id <- treatment_index_from_matrix(trt_mat, levels)
  row_id <- rep(seq_len(nr), times = nc)
  col_id <- rep(seq_len(nc), each = nr)

  Xt <- matrix(0, nrow = N, ncol = v)
  Xr <- matrix(0, nrow = N, ncol = nr)
  Xc <- matrix(0, nrow = N, ncol = nc)
  obs <- seq_len(N)
  Xt[cbind(obs, trt_id)] <- 1
  Xr[cbind(obs, row_id)] <- 1
  Xc[cbind(obs, col_id)] <- 1

  Z <- cbind(Intercept = 1, Xr, Xc)
  Pz <- Z %*% svd_ginv(t(Z) %*% Z, tol = tol) %*% t(Z)
  C <- t(Xt) %*% (diag(N) - Pz) %*% Xt
  C <- symmetrize_matrix(C)

  freq <- tabulate(trt_id, nbins = v)
  list(
    C = C,
    Xt = Xt,
    Xr = Xr,
    Xc = Xc,
    trt_id = trt_id,
    row_id = row_id,
    col_id = col_id,
    frequencies = freq,
    rows = nr,
    columns = nc,
    total_observations = N,
    total_treatments = v,
    replications = if (length(unique(freq)) == 1) unique(freq) else mean(freq),
    equireplicate = length(unique(freq)) == 1
  )
}

#' Check row and column balance
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param arr Numeric design array.
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
check_row_column_balance <- function(arr, levels) {
  nr <- dim(arr)[1]
  nc <- dim(arr)[2]
  nf <- dim(arr)[3]

  row_balance <- list()
  column_balance <- list()

  row_balanced_exact <- TRUE
  column_balanced_as_possible <- TRUE

  for (f in seq_len(nf)) {
    row_counts <- matrix(0, nrow = nr, ncol = levels[f])
    col_counts <- matrix(0, nrow = nc, ncol = levels[f])

    for (i in seq_len(nr)) {
      row_counts[i, ] <- tabulate(arr[i, , f] + 1, nbins = levels[f])
    }

    for (j in seq_len(nc)) {
      col_counts[j, ] <- tabulate(arr[, j, f] + 1, nbins = levels[f])
    }

    rownames(row_counts) <- paste0("R", seq_len(nr))
    colnames(row_counts) <- paste0("L", 0:(levels[f] - 1))

    rownames(col_counts) <- paste0("C", seq_len(nc))
    colnames(col_counts) <- paste0("L", 0:(levels[f] - 1))

    fname <- paste0("F", f)
    row_balance[[fname]] <- row_counts
    column_balance[[fname]] <- col_counts

    if (any(apply(row_counts, 1, function(z) length(unique(z)) != 1))) {
      row_balanced_exact <- FALSE
    }

    if (any(apply(col_counts, 1, function(z) max(z) - min(z) > 1))) {
      column_balanced_as_possible <- FALSE
    }
  }

  list(
    row_balance = row_balance,
    column_balance = column_balance,
    row_balanced_exact = row_balanced_exact,
    column_balanced_as_possible = column_balanced_as_possible
  )
}

#' Compute level-balance diagnostics
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param arr Numeric design array.
#' @param levels Integer vector of factor levels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
level_balance_diagnostics <- function(arr, levels) {
  levels <- as.integer(levels)
  nr <- dim(arr)[1]
  nc <- dim(arr)[2]
  nf <- length(levels)

  per_factor <- list()
  row_exact_all <- TRUE
  column_exact_all <- TRUE
  row_as_possible_all <- TRUE
  column_as_possible_all <- TRUE

  for (f in seq_len(nf)) {
    row_counts <- matrix(0, nrow = nr, ncol = levels[f])
    column_counts <- matrix(0, nrow = nc, ncol = levels[f])

    for (i in seq_len(nr)) {
      row_counts[i, ] <- tabulate(arr[i, , f] + 1, nbins = levels[f])
    }

    for (j in seq_len(nc)) {
      column_counts[j, ] <- tabulate(arr[, j, f] + 1, nbins = levels[f])
    }

    rownames(row_counts) <- paste0("R", seq_len(nr))
    colnames(row_counts) <- paste0("L", 0:(levels[f] - 1))
    rownames(column_counts) <- paste0("C", seq_len(nc))
    colnames(column_counts) <- paste0("L", 0:(levels[f] - 1))

    row_exact <- all(apply(row_counts, 1, function(z) length(unique(z)) == 1))
    col_exact <- all(apply(column_counts, 1, function(z) length(unique(z)) == 1))
    row_as_possible <- all(apply(row_counts, 1, function(z) max(z) - min(z) <= 1))
    col_as_possible <- all(apply(column_counts, 1, function(z) max(z) - min(z) <= 1))

    row_exact_all <- row_exact_all && row_exact
    column_exact_all <- column_exact_all && col_exact
    row_as_possible_all <- row_as_possible_all && row_as_possible
    column_as_possible_all <- column_as_possible_all && col_as_possible

    fname <- paste0("F", f)
    per_factor[[fname]] <- list(
      row_counts = row_counts,
      column_counts = column_counts,
      row_exact = row_exact,
      column_exact = col_exact,
      row_as_balanced_as_possible = row_as_possible,
      column_as_balanced_as_possible = col_as_possible
    )
  }

  list(
    per_factor = per_factor,
    row_exact_all = row_exact_all,
    column_exact_all = column_exact_all,
    row_as_balanced_as_possible_all = row_as_possible_all,
    column_as_balanced_as_possible_all = column_as_possible_all
  )
}

#' Count connected components from an information matrix
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param C Information matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
count_connected_components_from_C <- function(C, tol = 1e-7) {
  C <- as.matrix(C)
  v <- nrow(C)
  if (v <= 1) return(1L)
  A <- abs(C) > tol
  diag(A) <- FALSE
  visited <- rep(FALSE, v)
  n_components <- 0L
  for (start in seq_len(v)) {
    if (!visited[start]) {
      n_components <- n_components + 1L
      stack <- start
      visited[start] <- TRUE
      while (length(stack) > 0) {
        node <- stack[length(stack)]
        stack <- stack[-length(stack)]
        nbrs <- which(A[node, ] & !visited)
        if (length(nbrs) > 0) {
          visited[nbrs] <- TRUE
          stack <- c(stack, nbrs)
        }
      }
    }
  }
  n_components
}

#' Assess treatment connectedness from information matrix
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param C Information matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
connectedness_from_information <- function(C, tol = 1e-7) {
  C <- symmetrize_matrix(as.matrix(C))
  v <- nrow(C)
  required_rank <- max(v - 1L, 0L)
  rank <- matrix_rank_tol(C, tol = tol)
  data.frame(
    rank = rank,
    required_rank = required_rank,
    connected = rank >= required_rank,
    number_of_components = count_connected_components_from_C(C, tol = tol),
    stringsAsFactors = FALSE
  )
}

#' Compute connectedness diagnostics
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param info Function argument.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
connectedness_diagnostics <- function(info, tol = 1e-7) {
  Xt <- info$Xt
  Xr <- info$Xr
  Xc <- info$Xc
  freq <- as.numeric(info$frequencies)
  v <- info$total_treatments

  N_row <- t(Xt) %*% Xr
  N_col <- t(Xt) %*% Xc
  row_sizes <- colSums(Xr)
  col_sizes <- colSums(Xc)
  Dfreq <- diag(freq, nrow = v, ncol = v)

  C_row <- Dfreq - N_row %*% diag(1 / row_sizes, nrow = length(row_sizes)) %*% t(N_row)
  C_col <- Dfreq - N_col %*% diag(1 / col_sizes, nrow = length(col_sizes)) %*% t(N_col)
  C_design <- info$C

  row_conn <- connectedness_from_information(C_row, tol = tol)
  column_conn <- connectedness_from_information(C_col, tol = tol)
  design_conn <- connectedness_from_information(C_design, tol = tol)

  tab <- rbind(
    data.frame(component = "Rows", row_conn, stringsAsFactors = FALSE),
    data.frame(component = "Columns", column_conn, stringsAsFactors = FALSE),
    data.frame(component = "Row-column design", design_conn, stringsAsFactors = FALSE)
  )
  rownames(tab) <- NULL

  list(
    table = tab,
    row_connected = row_conn$connected,
    column_connected = column_conn$connected,
    design_connected = design_conn$connected,
    row_information_matrix = C_row,
    column_information_matrix = C_col,
    design_information_matrix = C_design
  )
}

#' Compute A-, D-, and E-efficiencies
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param eig Numeric vector of eigenvalues.
#' @param replications Replication number.
#' @param df Degrees of freedom.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
compute_ade_efficiency <- function(eig, replications, df, tol = 1e-7) {
  eig <- as.numeric(eig)
  eig[abs(eig) < tol] <- 0
  if (length(eig) < df) eig <- c(eig, rep(0, df - length(eig)))
  if (length(eig) > df) eig <- eig[seq_len(df)]

  if (is.na(replications) || replications <= 0 || df <= 0) {
    return(c(A_efficiency = NA_real_, D_efficiency = NA_real_, E_efficiency = NA_real_))
  }

  canonical <- eig / replications
  canonical[abs(canonical) < tol] <- 0
  canonical[canonical < 0 & abs(canonical) < tol] <- 0

  if (any(canonical <= tol)) {
    return(c(A_efficiency = 0, D_efficiency = 0, E_efficiency = 0))
  }

  c(
    A_efficiency = df / sum(1 / canonical),
    D_efficiency = exp(mean(log(canonical))),
    E_efficiency = min(canonical)
  )
}

#' Pseudo-inverse of a symmetric matrix
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param A Numeric matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
pseudo_inverse_symmetric <- function(A, tol = 1e-7) {
  A <- symmetrize_matrix(as.matrix(A))
  eg <- eigen(A, symmetric = TRUE)
  vals <- eg$values
  vals[abs(vals) < tol] <- 0
  inv_vals <- ifelse(vals > tol, 1 / vals, 0)
  G <- eg$vectors %*% diag(inv_vals, nrow = length(inv_vals)) %*% t(eg$vectors)
  symmetrize_matrix(G)
}

#' Compute E- and MV-optimality diagnostics
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param C Information matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
compute_emv_optimality <- function(C, tol = 1e-7) {
  C <- symmetrize_matrix(as.matrix(C))
  v <- nrow(C)
  required_rank <- v - 1

  eg <- eigen(C, symmetric = TRUE, only.values = TRUE)$values
  eg[abs(eg) < tol] <- 0
  positive_eig <- sort(eg[eg > tol])
  rank <- length(positive_eig)
  connected <- rank == required_rank

  E_value <- if (connected && length(positive_eig) > 0) min(positive_eig) else 0

  pairwise_variance <- matrix(NA_real_, nrow = v, ncol = v)
  rownames(pairwise_variance) <- colnames(pairwise_variance) <- paste0("T", seq_len(v))
  MV_value <- Inf
  worst_pair <- NA_character_
  mean_pairwise_variance <- NA_real_
  min_pairwise_variance <- NA_real_

  if (connected) {
    C_minus <- pseudo_inverse_symmetric(C, tol = tol)
    d <- diag(C_minus)
    pairwise_variance <- outer(d, d, "+") - 2 * C_minus
    pairwise_variance <- symmetrize_matrix(pairwise_variance)
    diag(pairwise_variance) <- 0

    upper_vals <- pairwise_variance[upper.tri(pairwise_variance)]
    MV_value <- max(upper_vals, na.rm = TRUE)
    mean_pairwise_variance <- mean(upper_vals, na.rm = TRUE)
    min_pairwise_variance <- min(upper_vals, na.rm = TRUE)

    idx <- which(pairwise_variance == MV_value & upper.tri(pairwise_variance), arr.ind = TRUE)
    if (nrow(idx) > 0) {
      worst_pair <- paste0("T", idx[1, 1], "-T", idx[1, 2])
    }
  }

  table <- data.frame(
    connected = connected,
    rank = rank,
    required_rank = required_rank,
    E_optimality_value = E_value,
    MV_optimality_value = MV_value,
    MV_worst_pair = worst_pair,
    min_pairwise_variance = min_pairwise_variance,
    mean_pairwise_variance = mean_pairwise_variance,
    stringsAsFactors = FALSE
  )

  list(
    table = table,
    eigenvalues = sort(eg, decreasing = TRUE),
    positive_eigenvalues = positive_eig,
    pairwise_variance_matrix = pairwise_variance
  )
}

#' Verify a mixed-level factorial row-column design
#'
#' Verify a mixed-level factorial row-column design.
#'
#' @param x An object.
#' @param levels Integer vector of factor levels.
#' @param sep Character separator used in treatment labels.
#' @param tol Numerical tolerance.
#' @param max_order Maximum factorial effect order to include.
#' @param verbose Logical; if TRUE, emit progress or summary messages.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' d <- mfrcd(c(2, 2), details = TRUE, check_properties = FALSE)
#' res <- verify_mfrcd(d, levels = c(2, 2))
#' stopifnot(is.list(res))
verify_mfrcd <- function(x,
                         levels = NULL,
                         sep = "",
                         tol = 1e-7,
                         max_order = NULL,
                         verbose = FALSE) {
  ext <- extract_numeric_design(x, levels = levels, sep = sep)
  arr <- ext$arr
  levels <- ext$levels
  nf <- length(levels)
  if (is.null(max_order)) max_order <- min(2L, nf)

  info <- make_row_column_information(arr, levels, tol = tol)
  C <- info$C
  r <- info$replications
  effects <- factorial_effect_bases(levels, max_order = max_order)
  effect_names <- names(effects)

  max_offdiag <- 0
  offdiag_table <- data.frame(
    effect1 = character(0),
    effect2 = character(0),
    max_abs_cross_information = numeric(0),
    stringsAsFactors = FALSE
  )
  if (length(effects) >= 2) {
    for (a in seq_len(length(effects) - 1)) {
      for (b in (a + 1):length(effects)) {
        Qa <- effects[[a]]$basis
        Qb <- effects[[b]]$basis
        cross <- t(Qa) %*% C %*% Qb
        val <- max(abs(cross))
        max_offdiag <- max(max_offdiag, val)
        offdiag_table <- rbind(
          offdiag_table,
          data.frame(
            effect1 = effect_names[a],
            effect2 = effect_names[b],
            max_abs_cross_information = val,
            stringsAsFactors = FALSE
          )
        )
      }
    }
  }
  ofs <- max_offdiag <= tol

  balance <- level_balance_diagnostics(arr, levels)
  connectedness <- connectedness_diagnostics(info, tol = tol)

  overall_eig <- eigen(symmetrize_matrix(C), symmetric = TRUE, only.values = TRUE)$values
  overall_eig[abs(overall_eig) < tol] <- 0
  overall_eig <- sort(overall_eig, decreasing = TRUE)
  overall_df <- info$total_treatments - 1
  overall_positive <- overall_eig[overall_eig > tol]
  if (length(overall_positive) < overall_df) {
    overall_eig_for_eff <- c(overall_positive, rep(0, overall_df - length(overall_positive)))
  } else {
    overall_eig_for_eff <- overall_positive[seq_len(overall_df)]
  }
  overall_ade <- compute_ade_efficiency(
    eig = overall_eig_for_eff,
    replications = r,
    df = overall_df,
    tol = tol
  )
  overall_efficiency <- data.frame(
    component = "All treatment contrasts",
    df = overall_df,
    rank = matrix_rank_tol(C, tol = tol),
    A_efficiency = unname(overall_ade["A_efficiency"]),
    D_efficiency = unname(overall_ade["D_efficiency"]),
    E_efficiency = unname(overall_ade["E_efficiency"]),
    stringsAsFactors = FALSE
  )

  emv <- compute_emv_optimality(C, tol = tol)
  optimality_criteria <- emv$table

  target_names <- effect_names[sapply(effects, function(e) e$order <= 2)]

  target_rows <- lapply(target_names, function(ename) {
    Q <- effects[[ename]]$basis
    B <- symmetrize_matrix(t(Q) %*% C %*% Q)
    eig <- eigen(B, symmetric = TRUE, only.values = TRUE)$values
    eig[abs(eig) < tol] <- 0

    df <- ncol(Q)
    rank <- matrix_rank_tol(B, tol = tol)
    estimable <- rank == df
    efficiency <- if (r > 0) eig / r else rep(NA_real_, length(eig))
    ade <- compute_ade_efficiency(eig = eig, replications = r, df = df, tol = tol)
    scalar <- mean(diag(B))
    balanced_information <- max(abs(B - scalar * diag(df))) <= tol
    full_efficiency <- estimable && all(abs(eig - r) <= tol)

    if (effects[[ename]]$order == 1) {
      row_exact <- balance$per_factor[[ename]]$row_exact
      col_exact <- balance$per_factor[[ename]]$column_exact
    } else {
      row_exact <- NA
      col_exact <- NA
    }

    data.frame(
      effect = ename,
      order = effects[[ename]]$order,
      df = df,
      rank = rank,
      estimable_after_rows_columns = estimable,
      balanced_information_matrix = balanced_information,
      full_efficiency = full_efficiency,
      unconfounded_effect = full_efficiency,
      row_level_balance_exact = row_exact,
      column_level_balance_exact = col_exact,
      min_efficiency_factor = min(efficiency),
      max_efficiency_factor = max(efficiency),
      A_efficiency = unname(ade["A_efficiency"]),
      D_efficiency = unname(ade["D_efficiency"]),
      E_efficiency = unname(ade["E_efficiency"]),
      stringsAsFactors = FALSE
    )
  })

  main_effects_and_2fi <- do.call(rbind, target_rows)
  main_effects <- main_effects_and_2fi[main_effects_and_2fi$order == 1, , drop = FALSE]

  all_effect_rows <- lapply(effect_names, function(ename) {
    Q <- effects[[ename]]$basis
    B <- symmetrize_matrix(t(Q) %*% C %*% Q)
    eig <- eigen(B, symmetric = TRUE, only.values = TRUE)$values
    eig[abs(eig) < tol] <- 0
    ade <- compute_ade_efficiency(eig = eig, replications = r, df = effects[[ename]]$df, tol = tol)
    data.frame(
      effect = ename,
      order = effects[[ename]]$order,
      df = effects[[ename]]$df,
      rank = matrix_rank_tol(B, tol = tol),
      estimable = matrix_rank_tol(B, tol = tol) == effects[[ename]]$df,
      min_eigenvalue = min(eig),
      max_eigenvalue = max(eig),
      A_efficiency = unname(ade["A_efficiency"]),
      D_efficiency = unname(ade["D_efficiency"]),
      E_efficiency = unname(ade["E_efficiency"]),
      stringsAsFactors = FALSE
    )
  })
  all_effects <- do.call(rbind, all_effect_rows)

  summary <- list(
    levels = levels,
    rows = info$rows,
    columns = info$columns,
    total_treatments = info$total_treatments,
    total_observations = info$total_observations,
    equireplicate = info$equireplicate,
    replications = info$replications,
    A_efficiency = unname(overall_ade["A_efficiency"]),
    D_efficiency = unname(overall_ade["D_efficiency"]),
    E_efficiency = unname(overall_ade["E_efficiency"]),
    E_optimality_value = optimality_criteria$E_optimality_value,
    MV_optimality_value = optimality_criteria$MV_optimality_value,
    MV_worst_pair = optimality_criteria$MV_worst_pair,
    row_connected = connectedness$row_connected,
    column_connected = connectedness$column_connected,
    design_connected = connectedness$design_connected,
    ofs = ofs,
    max_abs_cross_information_between_effects = max_offdiag,
    all_main_effects_estimable = all(main_effects$estimable_after_rows_columns),
    all_main_effects_balanced = all(main_effects$balanced_information_matrix),
    all_main_effects_full_efficiency = all(main_effects$full_efficiency),
    all_main_effects_unconfounded = all(main_effects$unconfounded_effect),
    all_main_and_2fi_estimable = all(main_effects_and_2fi$estimable_after_rows_columns),
    all_main_and_2fi_balanced = all(main_effects_and_2fi$balanced_information_matrix),
    all_main_and_2fi_full_efficiency = all(main_effects_and_2fi$full_efficiency),
    all_main_and_2fi_unconfounded = all(main_effects_and_2fi$unconfounded_effect),
    row_balance_exact_all_factors = balance$row_exact_all,
    column_balance_exact_all_factors = balance$column_exact_all,
    row_balance_as_possible_all_factors = balance$row_as_balanced_as_possible_all,
    column_balance_as_possible_all_factors = balance$column_as_balanced_as_possible_all
  )

  out <- list(
    summary = summary,
    main_effects = main_effects,
    main_effects_and_2fi = main_effects_and_2fi,
    all_effects = all_effects,
    overall_efficiency = overall_efficiency,
    optimality_criteria = optimality_criteria,
    E_MV_eigenvalues = emv$eigenvalues,
    elementary_contrast_variances = emv$pairwise_variance_matrix,
    ofs_cross_information = offdiag_table,
    connectedness = connectedness$table,
    balance = balance,
    information_matrix = C,
    row_information_matrix = connectedness$row_information_matrix,
    column_information_matrix = connectedness$column_information_matrix,
    treatment_frequencies = info$frequencies
  )

  if (verbose) {
    msg <- paste(
      "MFRCD verification",
      paste("  OFS:", summary$ofs),
      paste("  Row connected:", summary$row_connected),
      paste("  Column connected:", summary$column_connected),
      paste("  Row-column design connected:", summary$design_connected),
      paste("  A-efficiency:", summary$A_efficiency),
      paste("  D-efficiency:", summary$D_efficiency),
      paste("  E-efficiency:", summary$E_efficiency),
      paste("  E-optimality value z_d1:", summary$E_optimality_value),
      paste("  MV-optimality value Upsilon_d:", summary$MV_optimality_value),
      paste("  Main effects and two-factor interactions estimable:", summary$all_main_and_2fi_estimable),
      paste("  Main effects and two-factor interactions balanced:", summary$all_main_and_2fi_balanced),
      paste("  Main effects and two-factor interactions full efficiency/unconfounded:", summary$all_main_and_2fi_full_efficiency),
      paste("  Exact row balance:", summary$row_balance_exact_all_factors),
      paste("  Exact column balance:", summary$column_balance_exact_all_factors),
      sep = "\n"
    )
    message(msg)
  }

  out
}

#' Compact design property checks
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param property_checks Function argument.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
compact_property_checks <- function(property_checks) {
  design_checks <- data.frame(
    equireplicate = property_checks$summary$equireplicate,
    replications = property_checks$summary$replications,
    A_efficiency = property_checks$summary$A_efficiency,
    D_efficiency = property_checks$summary$D_efficiency,
    E_efficiency = property_checks$summary$E_efficiency,
    E_optimality_value = property_checks$summary$E_optimality_value,
    MV_optimality_value = property_checks$summary$MV_optimality_value,
    MV_worst_pair = property_checks$summary$MV_worst_pair,
    row_connected = property_checks$summary$row_connected,
    column_connected = property_checks$summary$column_connected,
    design_connected = property_checks$summary$design_connected,
    OFS = property_checks$summary$ofs,
    stringsAsFactors = FALSE
  )

  list(
    design_checks = design_checks,
    connectedness = property_checks$connectedness,
    overall_efficiency = property_checks$overall_efficiency,
    optimality_criteria = property_checks$optimality_criteria,
    main_effects_and_2fi = property_checks$main_effects_and_2fi,
    all_effects = property_checks$all_effects,
    ofs_cross_information = property_checks$ofs_cross_information
  )
}

#' Create a compact public output object
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param design A row-column design matrix.
#' @param property_checks Function argument.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
make_public_output <- function(design, property_checks) {
  pc <- compact_property_checks(property_checks)
  list(
    design = design,
    design_checks = pc$design_checks,
    connectedness = pc$connectedness,
    overall_efficiency = pc$overall_efficiency,
    optimality_criteria = pc$optimality_criteria,
    main_effects_and_2fi = pc$main_effects_and_2fi,
    all_effects = pc$all_effects,
    ofs_cross_information = pc$ofs_cross_information
  )
}

#' Generate a mixed-level factorial row-column design
#'
#' Generate a mixed-level factorial row-column design.
#'
#' @param levels Integer vector of factor levels.
#' @param block_size Block size used in the construction.
#' @param sep Character separator used in treatment labels.
#' @param details Logical; if TRUE, return construction details.
#' @param check_properties Logical; if TRUE, compute design-property diagnostics.
#' @param use_mixedfact Logical; if TRUE, allow the mixedfact-based construction route.
#' @param mixedfact_method Method passed to mixedfact when that route is used.
#' @param choose_block Rule for choosing a block when several are available.
#' @param group1 Optional integer vector of factor indices in the first group.
#' @param group2 Optional integer vector of factor indices in the second group.
#' @param prefer Construction route preference.
#' @param tol Numerical tolerance.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' d <- mfrcd(c(2, 2))
#' stopifnot(is.matrix(d))
mfrcd <- function(levels,
                  block_size = NULL,
                  sep = "",
                  details = FALSE,
                  check_properties = FALSE,
                  use_mixedfact = TRUE,
                  mixedfact_method = "auto",
                  choose_block = "best",
                  group1 = NULL,
                  group2 = NULL,
                  prefer = c("auto", "direct", "mixedfact"),
                  tol = 1e-7) {

  prefer <- match.arg(prefer)
  levels <- as.integer(levels)

  if (length(levels) < 2) stop("At least two factors are required.")
  if (any(levels <= 1)) stop("All factor levels must be greater than 1.")

  total_treatments <- prod(levels)
  block_size_supplied <- !missing(block_size) && !is.null(block_size)

  if (!block_size_supplied && prefer %in% c("auto", "direct")) {

    direct_group1 <- group1
    direct_group2 <- group2
    try_direct <- TRUE
    automatic_natural_split <- FALSE

    # For more than two factors, the square Method 1/2 construction should use
    # the natural split: first factor versus all remaining factors. If the gcd
    # for this split is 1, do not search other groupings; go to mixedfact in
    # prefer = "auto".
    if (length(levels) > 2 && is.null(group1) && is.null(group2)) {
      natural_s1 <- levels[1]
      natural_s2 <- prod(levels[-1])
      natural_gcd <- gcd_int(natural_s1, natural_s2)

      if (natural_gcd > 1) {
        direct_group1 <- 1L
        direct_group2 <- 2:length(levels)
        automatic_natural_split <- TRUE
      } else {
        try_direct <- FALSE
      }
    }

    direct_result <- NULL

    if (try_direct) {
      direct_result <- tryCatch(
        rc_factorial_n(
          levels = levels,
          sep = sep,
          details = TRUE,
          group1 = direct_group1,
          group2 = direct_group2
        ),
        error = function(e) NULL
      )
    }

    if (!is.null(direct_result)) {
      direct_result$construction_route <- if (automatic_natural_split) {
        "Direct Method 1/2 using natural split F1 | remaining factors"
      } else {
        "Direct Method 1/2"
      }
      if (check_properties) {
        direct_result$property_checks <- verify_mfrcd(direct_result, tol = tol, verbose = FALSE)
      }
      if (details) return(direct_result)
      if (check_properties) {
        return(make_public_output(
          design = direct_result$design,
          property_checks = direct_result$property_checks
        ))
      }
      return(direct_result$design)
    }

    if (prefer == "direct") {
      stop(
        paste0(
          "Direct Method 1/2 is not applicable for levels = c(",
          paste(levels, collapse = ", "),
          "). Use mfrcd(levels, block_size) or prefer = 'auto' to construct the design through mixedfact."
        )
      )
    }
  }

  if (!use_mixedfact) stop("mixedfact route is required, but use_mixedfact = FALSE.")

  if (!block_size_supplied) block_size <- max(levels)
  block_size <- as.integer(block_size)

  if (total_treatments %% block_size != 0) {
    stop(
      paste0(
        "block_size must divide total number of treatments. ",
        "Here prod(levels) = ", total_treatments,
        " and block_size = ", block_size, "."
      )
    )
  }

  pb_result <- rc_from_principal_block(
    levels = levels,
    block_size = block_size,
    principal_block = NULL,
    use_mixedfact = TRUE,
    mixedfact_method = mixedfact_method,
    choose_block = choose_block,
    sep = sep,
    details = TRUE
  )

  pb_result$construction_route <- "mixedfact principal-block method"
  pb_result$original_levels <- levels

  if (check_properties) {
    pb_result$property_checks <- verify_mfrcd(pb_result, tol = tol, verbose = FALSE)
  }

  if (details) return(pb_result)

  if (check_properties) {
    return(make_public_output(
      design = pb_result$design,
      property_checks = pb_result$property_checks
    ))
  }

  return(pb_result$design)
}

# ============================================================
# Factorial row-column design analysis
# Treatments may be coded as 1, 2, ..., prod(s1, ..., sn)
# in lexicographic factorial order.
# ============================================================

#' Extract positive eigenvalues
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param A Numeric matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
positive_eigenvalues <- function(A, tol = 1e-8) {
  A <- (A + t(A)) / 2
  ev <- eigen(A, symmetric = TRUE, only.values = TRUE)$values
  cutoff <- tol * max(1, max(abs(ev)))
  ev[ev > cutoff]
}

#' Rank of a symmetric matrix
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param A Numeric matrix.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
sym_rank <- function(A, tol = 1e-8) {
  length(positive_eigenvalues(A, tol = tol))
}

# ------------------------------------------------------------
# Create lexicographic factorial treatment map.
# Example: factor_levels = c(2, 3)
# gives 1=00, 2=01, 3=02, 4=10, 5=11, 6=12.
# ------------------------------------------------------------
#' Create a factorial treatment map
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param factor_levels Integer vector of factor levels.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
make_factorial_treatment_map <- function(factor_levels, sep = "") {
  if (is.numeric(factor_levels) && is.atomic(factor_levels)) {
    levs <- lapply(factor_levels, function(s) 0:(s - 1))
  } else if (is.list(factor_levels)) {
    levs <- factor_levels
  } else {
    stop("factor_levels must be either c(s1, s2, ..., sn) or a list of factor level vectors.")
  }

  nfac <- length(levs)

  # Reverse expand.grid order so last factor changes fastest.
  grid <- expand.grid(rev(levs), KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE)
  grid <- grid[, ncol(grid):1, drop = FALSE]
  names(grid) <- paste0("F", seq_len(nfac))

  factorial_label <- apply(grid, 1, paste0, collapse = sep)

  data.frame(
    treatment_no = seq_len(nrow(grid)),
    factorial_label = factorial_label,
    grid,
    check.names = FALSE
  )
}

# ------------------------------------------------------------
# Convert design entries to 1, 2, ..., v according to factorial order.
#
# input = "number":
#   design already contains 1, 2, ..., v.
#
# input = "factor_label":
#   design contains labels such as "00", "01", "02", "10", ...
#
# input = "auto":
#   tries to detect the format.
# ------------------------------------------------------------
#' Standardize a factorial row-column design
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
standardize_factorial_design <- function(design,
                                         factor_levels,
                                         input = c("auto", "number", "factor_label"),
                                         sep = "") {
  input <- match.arg(input)

  map <- make_factorial_treatment_map(factor_levels, sep = sep)
  v <- nrow(map)
  nfac <- ncol(map) - 2

  D <- as.matrix(design)
  nonmiss <- !is.na(D)
  tokens <- D[nonmiss]

  if (length(tokens) == 0) stop("Design contains no non-missing treatments.")

  ch <- as.character(tokens)
  num <- suppressWarnings(as.numeric(ch))

  if (input == "auto") {
    if (!any(is.na(num)) &&
        all(abs(num - round(num)) < 1e-8) &&
        all(num >= 1 & num <= v)) {
      input_used <- "number"
    } else if (all(ch %in% map$factorial_label)) {
      input_used <- "factor_label"
    } else if (sep == "" &&
               !any(is.na(num)) &&
               all(abs(num - round(num)) < 1e-8)) {
      padded <- sprintf(paste0("%0", nfac, "d"), as.integer(num))
      if (all(padded %in% map$factorial_label)) {
        input_used <- "factor_label"
        ch <- padded
      } else {
        stop("Could not identify treatment coding. Use input='number' or input='factor_label'.")
      }
    } else {
      stop("Could not identify treatment coding. Use input='number' or input='factor_label'.")
    }
  } else {
    input_used <- input
  }

  Dnum <- matrix(NA_integer_, nrow = nrow(D), ncol = ncol(D))
  dimnames(Dnum) <- dimnames(D)

  if (input_used == "number") {
    z <- suppressWarnings(as.numeric(as.character(tokens)))
    bad <- is.na(z) | abs(z - round(z)) > 1e-8 | z < 1 | z > v

    if (any(bad)) {
      stop("Some treatment numbers are not valid integers in 1,...,", v, ".")
    }

    Dnum[nonmiss] <- as.integer(z)
  }

  if (input_used == "factor_label") {
    ch2 <- as.character(tokens)
    idx <- match(ch2, map$factorial_label)

    # Allows unquoted numeric-looking labels such as 0,1,2,10,11,12
    # to be interpreted as 00,01,02,10,11,12 when sep="".
    if (any(is.na(idx)) && sep == "") {
      z <- suppressWarnings(as.numeric(ch2))
      padded <- ifelse(
        is.na(z),
        ch2,
        sprintf(paste0("%0", nfac, "d"), as.integer(z))
      )
      idx2 <- match(padded, map$factorial_label)
      idx[is.na(idx)] <- idx2[is.na(idx)]
    }

    if (any(is.na(idx))) {
      bad_values <- unique(ch2[is.na(idx)])
      stop("Some factorial labels are not valid: ",
           paste(bad_values, collapse = ", "))
    }

    Dnum[nonmiss] <- map$treatment_no[idx]
  }

  list(
    design_as_treatment_numbers = Dnum,
    factorial_treatment_map = map,
    input_used = input_used
  )
}

# ------------------------------------------------------------
# Main row-column design analysis
# ------------------------------------------------------------
#' Analyze a factorial row-column design
#'
#' Analyze a factorial row-column design.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param tol Numerical tolerance.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- analyse_rcd(D, factor_levels = c(2, 2), input = "number")
#' stopifnot(inherits(res, "rcd_analysis"))
analyse_rcd <- function(design,
                        factor_levels = NULL,
                        input = c("auto", "number", "factor_label"),
                        sep = "",
                        tol = 1e-8) {
  input <- match.arg(input)

  if (!is.null(factor_levels)) {
    std <- standardize_factorial_design(
      design = design,
      factor_levels = factor_levels,
      input = input,
      sep = sep
    )

    design_used <- std$design_as_treatment_numbers
    treatment_levels <- as.character(std$factorial_treatment_map$treatment_no)
    factorial_treatment_map <- std$factorial_treatment_map
    input_used <- std$input_used
  } else {
    design_used <- as.matrix(design)
    treatment_levels <- unique(as.character(design_used[!is.na(design_used)]))
    factorial_treatment_map <- NULL
    input_used <- "ordinary treatment labels"
  }

  cells <- which(!is.na(design_used), arr.ind = TRUE)

  if (nrow(cells) == 0) stop("Design has no non-empty cells.")

  trt_raw <- as.character(design_used[cells])

  dat <- data.frame(
    row = factor(cells[, 1]),
    col = factor(cells[, 2]),
    trt = factor(trt_raw, levels = treatment_levels)
  )

  v <- length(treatment_levels)
  nobs <- nrow(dat)

  Xt <- model.matrix(~ 0 + trt, dat)
  colnames(Xt) <- treatment_levels

  Z <- model.matrix(~ row + col, dat)

  # Treatment information matrix adjusted for rows and columns.
  R_Xt <- qr.resid(qr(Z, tol = tol), Xt)
  C <- crossprod(R_Xt)
  rownames(C) <- colnames(C) <- treatment_levels

  eig_pos <- positive_eigenvalues(C, tol = tol)
  rank_C <- length(eig_pos)
  connected <- rank_C == v - 1

  replications <- colSums(Xt)
  equireplicate <- length(unique(as.numeric(replications))) == 1
  r_common <- if (equireplicate) as.numeric(replications[1]) else NA_real_

  if (connected) {
    A_value <- sum(1 / eig_pos)
    D_value <- exp(mean(log(eig_pos)))
    E_value <- min(eig_pos)

    A_efficiency <- if (equireplicate) {
      (v - 1) / (r_common * A_value)
    } else NA_real_

    D_efficiency <- if (equireplicate) {
      D_value / r_common
    } else NA_real_

    E_efficiency <- if (equireplicate) {
      E_value / r_common
    } else NA_real_
  } else {
    A_value <- Inf
    D_value <- 0
    E_value <- 0
    A_efficiency <- NA_real_
    D_efficiency <- NA_real_
    E_efficiency <- NA_real_
  }

  RowMat <- model.matrix(~ 0 + row, dat)
  ColMat <- model.matrix(~ 0 + col, dat)

  M <- t(Xt) %*% RowMat
  N <- t(Xt) %*% ColMat
  rownames(M) <- rownames(N) <- treatment_levels

  if (all(replications > 0)) {
    AO <- t(M) %*% diag(1 / replications, nrow = v) %*% N
    adjusted_orthogonal <- max(abs(AO - 1)) < sqrt(tol)
  } else {
    AO <- NA
    adjusted_orthogonal <- NA
  }

  C_rowblock <- crossprod(qr.resid(qr(model.matrix(~ row, dat), tol = tol), Xt))
  C_colblock <- crossprod(qr.resid(qr(model.matrix(~ col, dat), tol = tol), Xt))

  row_block_rank <- sym_rank(C_rowblock, tol)
  col_block_rank <- sym_rank(C_colblock, tol)

  out <- list(
    input_used = input_used,
    design_as_treatment_numbers = design_used,
    factorial_treatment_map = factorial_treatment_map,

    number_of_observations = nobs,
    number_of_treatments = v,
    treatment_labels = treatment_levels,
    replications = replications,
    equireplicate = equireplicate,

    C_matrix = C,
    positive_eigenvalues = eig_pos,
    rank_C = rank_C,
    connected = connected,
    treatment_disconnectedness_degree = (v - 1) - rank_C,

    A_value_sum_inverse_eigenvalues = A_value,
    D_value_geometric_mean_eigenvalues = D_value,
    E_value_minimum_eigenvalue = E_value,

    A_efficiency = A_efficiency,
    D_efficiency = D_efficiency,
    E_efficiency = E_efficiency,

    treatment_row_incidence = M,
    treatment_column_incidence = N,
    adjusted_orthogonality_matrix = AO,
    adjusted_orthogonal = adjusted_orthogonal,

    row_block_connected = row_block_rank == v - 1,
    column_block_connected = col_block_rank == v - 1,
    row_block_rank = row_block_rank,
    column_block_rank = col_block_rank
  )

  class(out) <- "rcd_analysis"
  out
}

#' Print a row-column design analysis
#'
#' Print a row-column design analysis.
#'
#' @param x An object.
#' @param digits Number of digits used for printing.
#' @param ... Additional arguments passed to or from methods.
#'
#' @return Invisibly returns `x`.
#' @method print rcd_analysis
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- analyse_rcd(D, factor_levels = c(2, 2), input = "number")
#' print(res)
print.rcd_analysis <- function(x, digits = 6, ...) {
  cat("Row-column design analysis\n")
  cat("----------------------------------------\n")

  cat("Treatment coding:", x$input_used, "\n")
  cat("Treatments:", x$number_of_treatments, "\n")
  cat("Observations:", x$number_of_observations, "\n")
  cat("Equireplicate:", x$equireplicate, "\n")
  cat("Connected for treatments:", x$connected, "\n")
  cat("rank(C):", x$rank_C, "\n")
  cat("Degree of disconnectedness:",
      x$treatment_disconnectedness_degree, "\n\n")

  cat("Component block connectedness\n")
  cat("Rows as blocks:", x$row_block_connected, "\n")
  cat("Columns as blocks:", x$column_block_connected, "\n\n")

  cat("Adjusted orthogonal:", x$adjusted_orthogonal, "\n\n")

  cat("Optimality values from positive eigenvalues of C\n")
  cat("A value, sum(1/lambda):",
      round(x$A_value_sum_inverse_eigenvalues, digits), "\n")
  cat("D value, geometric mean(lambda):",
      round(x$D_value_geometric_mean_eigenvalues, digits), "\n")
  cat("E value, min(lambda):",
      round(x$E_value_minimum_eigenvalue, digits), "\n\n")

  cat("Efficiencies, meaningful when equireplicate\n")
  cat("A efficiency:", round(x$A_efficiency, digits), "\n")
  cat("D efficiency:", round(x$D_efficiency, digits), "\n")
  cat("E efficiency:", round(x$E_efficiency, digits), "\n")

  invisible(x)
}

# ------------------------------------------------------------
# Tetra-difference connectedness check
# Complete rectangular designs only: no NA cells.
# ------------------------------------------------------------
#' Check connectedness of a row-column design
#'
#' Check connectedness of a row-column design.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param tol Numerical tolerance.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- tetra_connectedness(D, factor_levels = c(2, 2), input = "number")
#' stopifnot(is.logical(res$connected))
tetra_connectedness <- function(design,
                                factor_levels = NULL,
                                input = c("auto", "number", "factor_label"),
                                sep = "",
                                tol = 1e-8) {
  input <- match.arg(input)

  if (!is.null(factor_levels)) {
    std <- standardize_factorial_design(
      design = design,
      factor_levels = factor_levels,
      input = input,
      sep = sep
    )
    D <- std$design_as_treatment_numbers
    trt_levels <- as.character(std$factorial_treatment_map$treatment_no)
  } else {
    D <- as.matrix(design)
    trt_levels <- unique(as.character(as.vector(D)))
  }

  if (any(is.na(D))) {
    stop("tetra_connectedness assumes a complete rectangular design with no NA cells.")
  }

  v <- length(trt_levels)
  rows <- list()
  idx <- 1

  for (i in 2:nrow(D)) {
    for (j in 2:ncol(D)) {
      z <- setNames(rep(0, v), trt_levels)

      z[as.character(D[1, 1])] <- z[as.character(D[1, 1])] + 1
      z[as.character(D[i, 1])] <- z[as.character(D[i, 1])] - 1
      z[as.character(D[1, j])] <- z[as.character(D[1, j])] - 1
      z[as.character(D[i, j])] <- z[as.character(D[i, j])] + 1

      if (any(z != 0)) {
        rows[[idx]] <- z
        idx <- idx + 1
      }
    }
  }

  A <- do.call(rbind, rows)
  rank_A <- qr(A, tol = tol)$rank

  list(
    tetra_matrix = A,
    rank = rank_A,
    connected = rank_A == v - 1,
    degree_of_disconnectedness = (v - 1) - rank_A
  )
}
# ============================================================
# Bounded row-column repair for replicated factorial designs
# ============================================================

#' Resolve treatment replication setting
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dnum Numeric design matrix.
#' @param v Function argument.
#' @param replication Replication target or "auto".
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
resolve_replication <- function(Dnum, v, replication = "auto") {
  if (is.null(replication)) return(NULL)

  if (identical(replication, "auto")) {
    nobs <- sum(!is.na(Dnum))

    if (nobs %% v != 0) {
      stop(
        "Total number of non-missing observations is not divisible by ",
        "the number of treatments. Cannot infer common replication."
      )
    }

    return(nobs / v)
  }

  replication
}

#' Check feasibility of a row-column design
#'
#' Check feasibility of a row-column design.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param tol Numerical tolerance.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- rcd_feasibility_check(D, factor_levels = c(2, 2), input = "number")
#' stopifnot(is.list(res))
rcd_feasibility_check <- function(design,
                                  factor_levels,
                                  input = c("factor_label", "number", "auto"),
                                  sep = "",
                                  tol = 1e-8) {
  input <- match.arg(input)

  std <- standardize_factorial_design(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep
  )

  Dnum <- std$design_as_treatment_numbers
  v <- prod(factor_levels)

  cells <- which(!is.na(Dnum), arr.ind = TRUE)

  dat <- data.frame(
    row = factor(cells[, 1]),
    col = factor(cells[, 2])
  )

  Z <- model.matrix(~ row + col, dat)

  nuisance_rank <- qr(Z, tol = tol)$rank
  available_treatment_df <- nrow(cells) - nuisance_rank
  required_treatment_df <- v - 1

  list(
    possible = available_treatment_df >= required_treatment_df,
    rows = nrow(Dnum),
    columns = ncol(Dnum),
    number_of_treatments = v,
    observations = nrow(cells),
    available_treatment_df = available_treatment_df,
    required_treatment_df = required_treatment_df,
    message = if (available_treatment_df >= required_treatment_df) {
      "Connectedness is not ruled out by the degrees-of-freedom condition."
    } else {
      paste0(
        "Connectedness is impossible for this row-column size. ",
        "Available treatment df after row and column adjustment = ",
        available_treatment_df,
        ", but required treatment df = ",
        required_treatment_df,
        "."
      )
    }
  )
}

#' Validate row-column replication bounds
#'
#' Validate row-column replication bounds.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param replication Replication target or "auto".
#' @param max_per_row Maximum allowed occurrences of a treatment in a row.
#' @param max_per_column Maximum allowed occurrences of a treatment in a column.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- validate_bounded_rcd(D, factor_levels = c(2, 2), input = "number")
#' stopifnot(is.list(res))
validate_bounded_rcd <- function(design,
                                 factor_levels,
                                 input = c("factor_label", "number", "auto"),
                                 sep = "",
                                 replication = "auto",
                                 max_per_row = 1,
                                 max_per_column = 1) {
  input <- match.arg(input)

  std <- standardize_factorial_design(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep
  )

  Dnum <- std$design_as_treatment_numbers
  v <- prod(factor_levels)

  replication <- resolve_replication(Dnum, v, replication)

  counts <- tabulate(as.integer(Dnum[!is.na(Dnum)]), nbins = v)

  problems <- character(0)

  if (!is.null(replication)) {
    bad <- which(counts != replication)

    if (length(bad) > 0) {
      bad_lab <- std$factorial_treatment_map$factorial_label[bad]

      problems <- c(
        problems,
        paste0(
          "These treatments do not have replication ",
          replication,
          ": ",
          paste(bad_lab, collapse = ", ")
        )
      )
    }
  }

  for (i in seq_len(nrow(Dnum))) {
    x <- Dnum[i, ]
    x <- x[!is.na(x)]

    row_counts <- tabulate(as.integer(x), nbins = v)
    bad <- which(row_counts > max_per_row)

    if (length(bad) > 0) {
      bad_lab <- std$factorial_treatment_map$factorial_label[bad]

      problems <- c(
        problems,
        paste0(
          "Row ", i,
          " has treatments appearing more than max_per_row = ",
          max_per_row,
          ": ",
          paste(bad_lab, collapse = ", ")
        )
      )
    }
  }

  for (j in seq_len(ncol(Dnum))) {
    x <- Dnum[, j]
    x <- x[!is.na(x)]

    col_counts <- tabulate(as.integer(x), nbins = v)
    bad <- which(col_counts > max_per_column)

    if (length(bad) > 0) {
      bad_lab <- std$factorial_treatment_map$factorial_label[bad]

      problems <- c(
        problems,
        paste0(
          "Column ", j,
          " has treatments appearing more than max_per_column = ",
          max_per_column,
          ": ",
          paste(bad_lab, collapse = ", ")
        )
      )
    }
  }

  list(
    valid = length(problems) == 0,
    problems = problems,
    design_as_treatment_numbers = Dnum,
    treatment_map = std$factorial_treatment_map,
    treatment_replications = counts,
    replication = replication,
    max_per_row = max_per_row,
    max_per_column = max_per_column
  )
}

#' Check row-column replication constraints
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dnum Numeric design matrix.
#' @param v Function argument.
#' @param replication Replication target or "auto".
#' @param max_per_row Maximum allowed occurrences of a treatment in a row.
#' @param max_per_column Maximum allowed occurrences of a treatment in a column.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
rcd_constraints_ok <- function(Dnum,
                               v,
                               replication = NULL,
                               max_per_row = 1,
                               max_per_column = 1) {
  x <- Dnum[!is.na(Dnum)]

  if (!is.null(replication)) {
    counts <- tabulate(as.integer(x), nbins = v)

    if (!all(counts == replication)) {
      return(FALSE)
    }
  }

  for (i in seq_len(nrow(Dnum))) {
    z <- Dnum[i, ]
    z <- z[!is.na(z)]

    row_counts <- tabulate(as.integer(z), nbins = v)

    if (any(row_counts > max_per_row)) {
      return(FALSE)
    }
  }

  for (j in seq_len(ncol(Dnum))) {
    z <- Dnum[, j]
    z <- z[!is.na(z)]

    col_counts <- tabulate(as.integer(z), nbins = v)

    if (any(col_counts > max_per_column)) {
      return(FALSE)
    }
  }

  TRUE
}

#' Convert design numbers to factor labels
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dnum Numeric design matrix.
#' @param factorial_treatment_map Function argument.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
design_numbers_to_factor_labels <- function(Dnum, factorial_treatment_map) {
  Dlab <- matrix(NA_character_, nrow = nrow(Dnum), ncol = ncol(Dnum))
  dimnames(Dlab) <- dimnames(Dnum)

  ok <- !is.na(Dnum)
  Dlab[ok] <- factorial_treatment_map$factorial_label[as.integer(Dnum[ok])]

  Dlab
}

#' List changed cells between two designs
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param old_design Original design matrix.
#' @param new_design New design matrix.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
cell_changes <- function(old_design, new_design) {
  old_design <- as.matrix(old_design)
  new_design <- as.matrix(new_design)

  changed <- which(old_design != new_design, arr.ind = TRUE)

  if (nrow(changed) == 0) {
    return(data.frame())
  }

  data.frame(
    row = changed[, 1],
    column = changed[, 2],
    old = old_design[changed],
    new = new_design[changed],
    row.names = NULL
  )
}

#' Compute a row-column design score
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param ans Analysis result.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
rcd_score <- function(ans) {
  eig <- ans$positive_eigenvalues

  if (length(eig) == 0) {
    return(c(rank = 0, Emin = 0, logdet = -Inf))
  }

  c(
    rank = ans$rank_C,
    Emin = min(eig),
    logdet = sum(log(pmax(eig, 1e-12)))
  )
}

#' Compare row-column design scores
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param new_score Candidate score.
#' @param old_score Current score.
#' @param tol Numerical tolerance.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
score_better <- function(new_score, old_score, tol = 1e-10) {
  if (new_score["rank"] > old_score["rank"]) return(TRUE)
  if (new_score["rank"] < old_score["rank"]) return(FALSE)

  if (new_score["Emin"] > old_score["Emin"] + tol) return(TRUE)
  if (new_score["Emin"] < old_score["Emin"] - tol) return(FALSE)

  if (new_score["logdet"] > old_score["logdet"] + tol) return(TRUE)

  FALSE
}

#' Search for an improving bounded swap
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dnum Numeric design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param sep Character separator used in treatment labels.
#' @param tol Numerical tolerance.
#' @param replication Replication target or "auto".
#' @param max_per_row Maximum allowed occurrences of a treatment in a row.
#' @param max_per_column Maximum allowed occurrences of a treatment in a column.
#' @param max_candidates Maximum number of candidate swaps to examine.
#' @param show_progress Logical; if TRUE, show a progress bar.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
try_best_swap_once_bounded <- function(Dnum,
                                       factor_levels,
                                       sep = "",
                                       tol = 1e-8,
                                       replication = NULL,
                                       max_per_row = 1,
                                       max_per_column = 1,
                                       max_candidates = NULL,
                                       show_progress = FALSE) {
  cells <- which(!is.na(Dnum), arr.ind = TRUE)
  m <- nrow(cells)
  v <- prod(factor_levels)

  current_ans <- analyse_rcd(
    design = Dnum,
    factor_levels = factor_levels,
    input = "number",
    sep = sep,
    tol = tol
  )

  current_score <- rcd_score(current_ans)

  best_D <- Dnum
  best_ans <- current_ans
  best_score <- current_score
  best_swap <- NULL

  if (is.null(max_candidates)) {
    max_candidates <- min(5000L, as.integer(m * (m - 1) / 2))
  }

  a <- sample.int(m, max_candidates, replace = TRUE)
  b <- sample.int(m, max_candidates, replace = TRUE)
  keep <- a != b
  candidate_pairs <- rbind(a[keep], b[keep])

  n_candidates <- ncol(candidate_pairs)

  if (show_progress) {
    cat("\nChecking", n_candidates, "candidate swaps...\n")
    flush.console()
    pb <- txtProgressBar(min = 0, max = n_candidates, style = 3)
    on.exit(close(pb), add = TRUE)
  }

  for (h in seq_len(n_candidates)) {

    if (show_progress && (h %% 10 == 0 || h == n_candidates)) {
      setTxtProgressBar(pb, h)
      flush.console()
    }

    a <- candidate_pairs[1, h]
    b <- candidate_pairs[2, h]

    r1 <- cells[a, 1]
    c1 <- cells[a, 2]
    r2 <- cells[b, 1]
    c2 <- cells[b, 2]

    if (Dnum[r1, c1] == Dnum[r2, c2]) next

    Dtry <- Dnum

    tmp <- Dtry[r1, c1]
    Dtry[r1, c1] <- Dtry[r2, c2]
    Dtry[r2, c2] <- tmp

    if (!rcd_constraints_ok(
      Dtry,
      v = v,
      replication = replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column
    )) {
      next
    }

    ans_try <- analyse_rcd(
      design = Dtry,
      factor_levels = factor_levels,
      input = "number",
      sep = sep,
      tol = tol
    )

    score_try <- rcd_score(ans_try)

    if (score_better(score_try, best_score, tol = tol)) {
      best_D <- Dtry
      best_ans <- ans_try
      best_score <- score_try
      best_swap <- c(row1 = r1, col1 = c1, row2 = r2, col2 = c2)

      if (show_progress) {
        cat(
          "\nImprovement found at candidate", h,
          "| rank =", best_ans$rank_C,
          "| connected =", best_ans$connected, "\n"
        )
        flush.console()
      }

      if (best_ans$connected) break
    }
  }

  list(
    improved = !is.null(best_swap),
    design = best_D,
    analysis = best_ans,
    score = best_score,
    swap = best_swap
  )
}

#' Repair a row-column design under bounded swaps
#'
#' Repair a row-column design under bounded swaps.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param tol Numerical tolerance.
#' @param replication Replication target or "auto".
#' @param horizontal_reps Maximum horizontal replication bound.
#' @param vertical_reps Maximum vertical replication bound.
#' @param max_per_row Maximum allowed occurrences of a treatment in a row.
#' @param max_per_column Maximum allowed occurrences of a treatment in a column.
#' @param max_iter Maximum number of repair iterations.
#' @param max_candidates Maximum number of candidate swaps to examine.
#' @param seed Optional random seed.
#' @param verbose Logical; if TRUE, emit progress or summary messages.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- make_connected_rcd_bounded(
#'   D, factor_levels = c(2, 2), input = "number",
#'   max_iter = 1, max_candidates = 5
#' )
#' stopifnot(is.list(res))
make_connected_rcd_bounded <- function(design,
                                       factor_levels,
                                       input = c("factor_label", "number", "auto"),
                                       sep = "",
                                       tol = 1e-8,
                                       replication = "auto",
                                       horizontal_reps = 1,
                                       vertical_reps = 1,
                                       max_per_row = horizontal_reps,
                                       max_per_column = vertical_reps,
                                       max_iter = 100,
                                       max_candidates = NULL,
                                       seed = NULL,
                                       verbose = FALSE) {
  input <- match.arg(input)

  if (!is.null(seed)) set.seed(seed)

  valid_check <- validate_bounded_rcd(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep,
    replication = replication,
    max_per_row = max_per_row,
    max_per_column = max_per_column
  )

  if (!valid_check$valid) {
    return(list(
      connected_before = NA,
      connected_after = NA,
      message = "The supplied design violates the requested row-column replication rules.",
      problems = valid_check$problems,
      treatment_map = valid_check$treatment_map,
      replication = valid_check$replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column
    ))
  }

  feasible <- rcd_feasibility_check(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep,
    tol = tol
  )

  Dcur <- valid_check$design_as_treatment_numbers
  treatment_map <- valid_check$treatment_map

  original_labels <- design_numbers_to_factor_labels(Dcur, treatment_map)

  if (!feasible$possible) {
    return(list(
      connected_before = FALSE,
      connected_after = FALSE,
      message = feasible$message,
      feasibility = feasible,
      original_design = original_labels,
      repaired_design = original_labels,
      treatment_map = treatment_map,
      replication = valid_check$replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      changes = data.frame(),
      swaps = data.frame()
    ))
  }

  original_ans <- analyse_rcd(
    design = Dcur,
    factor_levels = factor_levels,
    input = "number",
    sep = sep,
    tol = tol
  )

  if (original_ans$connected) {
    return(list(
      connected_before = TRUE,
      connected_after = TRUE,
      message = "The original design is already connected.",
      original_design = original_labels,
      repaired_design = original_labels,
      treatment_map = treatment_map,
      replication = valid_check$replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      original_analysis = original_ans,
      repaired_analysis = original_ans,
      changes = data.frame(),
      swaps = data.frame()
    ))
  }

  swaps <- data.frame()

  if (isTRUE(verbose)) progress_msg("Repair started. Maximum iterations = ", max_iter)

  for (iter in seq_len(max_iter)) {

    if (isTRUE(verbose)) progress_msg("Repair iteration ", iter, " of ", max_iter, " started...")

    step <- try_best_swap_once_bounded(
      Dnum = Dcur,
      factor_levels = factor_levels,
      sep = sep,
      tol = tol,
      replication = valid_check$replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      max_candidates = max_candidates,
      show_progress = verbose
    )

    if (isTRUE(verbose)) progress_msg(
      "Repair iteration ", iter,
      " completed. Improved = ", step$improved,
      ", rank = ", step$analysis$rank_C,
      ", connected = ", step$analysis$connected
    )

    if (!step$improved) {
      if (isTRUE(verbose)) progress_msg("No improvement found. Repair stopped.")
      break
    }

    Dcur <- step$design

    swaps <- rbind(
      swaps,
      data.frame(
        iteration = iter,
        row1 = step$swap["row1"],
        col1 = step$swap["col1"],
        row2 = step$swap["row2"],
        col2 = step$swap["col2"],
        rank_C = step$analysis$rank_C,
        connected = step$analysis$connected,
        row.names = NULL
      )
    )

    if (step$analysis$connected) {
      if (isTRUE(verbose)) progress_msg("Connected design found at repair iteration ", iter, ".")
      break
    }
  }

  repaired_ans <- analyse_rcd(
    design = Dcur,
    factor_levels = factor_levels,
    input = "number",
    sep = sep,
    tol = tol
  )

  repaired_labels <- design_numbers_to_factor_labels(Dcur, treatment_map)

  list(
    connected_before = FALSE,
    connected_after = repaired_ans$connected,
    message = if (repaired_ans$connected) {
      "A connected design was found without violating the requested row-column replication rules."
    } else {
      "No connected design was found under the requested row-column replication rules."
    },
    feasibility = feasible,
    original_design = original_labels,
    repaired_design = repaired_labels,
    treatment_map = treatment_map,
    replication = valid_check$replication,
    max_per_row = max_per_row,
    max_per_column = max_per_column,
    original_analysis = original_ans,
    repaired_analysis = repaired_ans,
    changes = cell_changes(original_labels, repaired_labels),
    swaps = swaps
  )
}

#' Summarize a row-column design layout
#'
#' Summarize a row-column design layout.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' res <- summarize_rcd_layout(D, factor_levels = c(2, 2), input = "number")
#' stopifnot(is.list(res))
#' stopifnot(is.data.frame(res$total_replication_by_treatment))
summarize_rcd_layout <- function(design,
                                 factor_levels,
                                 input = c("factor_label", "number", "auto"),
                                 sep = "") {
  input <- match.arg(input)

  std <- standardize_factorial_design(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep
  )

  Dnum <- std$design_as_treatment_numbers
  map <- std$factorial_treatment_map
  v <- prod(factor_levels)

  total_counts <- tabulate(as.integer(Dnum[!is.na(Dnum)]), nbins = v)

  row_max <- 0
  col_max <- 0

  row_details <- list()
  col_details <- list()

  for (i in seq_len(nrow(Dnum))) {
    z <- Dnum[i, ]
    z <- z[!is.na(z)]
    cnt <- tabulate(as.integer(z), nbins = v)
    row_max <- max(row_max, max(cnt))

    bad <- which(cnt > 1)
    if (length(bad) > 0) {
      row_details[[length(row_details) + 1]] <- data.frame(
        row = i,
        treatment = map$factorial_label[bad],
        count = cnt[bad]
      )
    }
  }

  for (j in seq_len(ncol(Dnum))) {
    z <- Dnum[, j]
    z <- z[!is.na(z)]
    cnt <- tabulate(as.integer(z), nbins = v)
    col_max <- max(col_max, max(cnt))

    bad <- which(cnt > 1)
    if (length(bad) > 0) {
      col_details[[length(col_details) + 1]] <- data.frame(
        column = j,
        treatment = map$factorial_label[bad],
        count = cnt[bad]
      )
    }
  }

  list(
    treatment_map = map,
    total_replication_by_treatment = data.frame(
      treatment = map$factorial_label,
      count = total_counts
    ),
    common_replication = if (length(unique(total_counts)) == 1) unique(total_counts) else NA,
    observed_max_per_row = row_max,
    observed_max_per_column = col_max,
    repeated_within_rows = if (length(row_details) == 0) data.frame() else do.call(rbind, row_details),
    repeated_within_columns = if (length(col_details) == 0) data.frame() else do.call(rbind, col_details)
  )
}
#' Summarize row-column design analysis
#'
#' Summarize row-column design analysis.
#'
#' @param ans Analysis result.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- matrix(c(1, 2, 3, 4), nrow = 2)
#' ans <- analyse_rcd(D, factor_levels = c(2, 2), input = "number")
#' res <- rcd_analysis_summary(ans)
#' stopifnot(is.data.frame(res))
rcd_analysis_summary <- function(ans) {
  data.frame(
    treatments = ans$number_of_treatments,
    observations = ans$number_of_observations,
    equireplicate = ans$equireplicate,
    connected = ans$connected,
    rank_C = ans$rank_C,
    required_rank = ans$number_of_treatments - 1,
    disconnectedness_degree = ans$treatment_disconnectedness_degree,
    row_block_connected = ans$row_block_connected,
    column_block_connected = ans$column_block_connected,
    adjusted_orthogonal = ans$adjusted_orthogonal,
    A_value = ans$A_value_sum_inverse_eigenvalues,
    D_value = ans$D_value_geometric_mean_eigenvalues,
    E_value = ans$E_value_minimum_eigenvalue,
    A_efficiency = ans$A_efficiency,
    D_efficiency = ans$D_efficiency,
    E_efficiency = ans$E_efficiency,
    stringsAsFactors = FALSE
  )
}

#' Extract a design matrix from an MFRCD result
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
extract_design_from_mfrcd_result <- function(x) {
  if (is.list(x) && !is.null(x$design)) {
    return(as.matrix(x$design))
  }

  if (is.matrix(x) || is.data.frame(x)) {
    return(as.matrix(x))
  }

  stop("Could not find a design matrix. Expected an mfrcd details object with $design or a matrix.")
}


#' Find complete treatment sets in rows or columns
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dnum Numeric design matrix.
#' @param v Function argument.
#' @param margin Margin to search, either rows or columns.
#' @param max_solutions_checked Maximum number of candidate partitions to check.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
find_complete_treatment_partition <- function(Dnum,
                                              v,
                                              margin = c("rows", "columns"),
                                              max_solutions_checked = 100000L) {
  margin <- match.arg(margin)

  if (margin == "rows") {
    n_units <- nrow(Dnum)
    cells_per_unit <- ncol(Dnum)
    get_values <- function(idx) as.integer(Dnum[idx, , drop = FALSE])
  } else {
    n_units <- ncol(Dnum)
    cells_per_unit <- nrow(Dnum)
    get_values <- function(idx) as.integer(Dnum[, idx, drop = FALSE])
  }

  if (cells_per_unit <= 0 || v %% cells_per_unit != 0) {
    return(list(
      success = FALSE,
      margin = margin,
      message = paste0("A complete treatment set cannot be formed from whole ", margin,
                       " because number of treatments is not divisible by cells per ",
                       sub("s$", "", margin), ".")
    ))
  }

  group_size <- v / cells_per_unit

  if (group_size < 1 || n_units %% group_size != 0) {
    return(list(
      success = FALSE,
      margin = margin,
      group_size = group_size,
      message = paste0("The ", margin, " cannot be partitioned into equal complete treatment sets.")
    ))
  }

  is_complete_group <- function(idx) {
    vals <- get_values(idx)
    vals <- vals[!is.na(vals)]
    if (length(vals) != v) return(FALSE)
    counts <- tabulate(vals, nbins = v)
    all(counts == 1)
  }

  checked <- 0L

  search_partition <- function(remaining, groups) {
    if (length(remaining) == 0) return(groups)
    if (checked > max_solutions_checked) return(NULL)

    first <- remaining[1]

    if (group_size == 1) {
      candidate_groups <- list(first)
    } else {
      others <- remaining[-1]
      if (length(others) < group_size - 1) return(NULL)
      candidate_groups <- combn(others, group_size - 1, simplify = FALSE)
      candidate_groups <- lapply(candidate_groups, function(z) c(first, z))
    }

    for (g in candidate_groups) {
      checked <<- checked + 1L
      if (checked > max_solutions_checked) return(NULL)

      if (is_complete_group(g)) {
        next_remaining <- setdiff(remaining, g)
        ans <- search_partition(next_remaining, c(groups, list(g)))
        if (!is.null(ans)) return(ans)
      }
    }

    NULL
  }

  groups <- search_partition(seq_len(n_units), list())

  if (is.null(groups)) {
    return(list(
      success = FALSE,
      margin = margin,
      group_size = group_size,
      checked = checked,
      message = paste0("No partition of ", margin,
                       " into complete treatment sets was found.")
    ))
  }

  list(
    success = TRUE,
    margin = margin,
    group_size = group_size,
    number_of_complete_sets = length(groups),
    groups = groups,
    order = unlist(groups, use.names = FALSE),
    checked = checked,
    message = paste0("The ", margin,
                     " were reordered into consecutive complete treatment sets.")
  )
}

#' Create a D2 design from complete treatment sets
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param prefer_margin Preferred margin for complete-set reshuffling.
#' @param tol Numerical tolerance.
#' @param max_solutions_checked Maximum number of candidate partitions to check.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
make_D2_from_complete_sets <- function(design,
                                       factor_levels,
                                       input = c("factor_label", "number", "auto"),
                                       sep = "",
                                       prefer_margin = c("rows", "columns"),
                                       tol = 1e-8,
                                       max_solutions_checked = 100000L) {
  input <- match.arg(input)
  prefer_margin <- match.arg(prefer_margin)

  std <- standardize_factorial_design(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep
  )

  Dnum <- std$design_as_treatment_numbers
  treatment_map <- std$factorial_treatment_map
  original_labels <- design_numbers_to_factor_labels(Dnum, treatment_map)
  v <- prod(factor_levels)

  original_analysis <- analyse_rcd(
    design = original_labels,
    factor_levels = factor_levels,
    input = "factor_label",
    sep = sep,
    tol = tol
  )

  if (original_analysis$connected) {
    return(list(
      reshuffled = FALSE,
      direction = "none",
      message = "The original generated design is connected; D2 is the original $design matrix.",
      design = original_labels,
      design_as_numbers = Dnum,
      treatment_map = treatment_map,
      original_analysis = original_analysis,
      row_order = seq_len(nrow(Dnum)),
      column_order = seq_len(ncol(Dnum)),
      partition = NULL,
      horizontal_reps_default = max(summarize_rcd_layout(original_labels, factor_levels, "factor_label", sep)$observed_max_per_row, 1),
      vertical_reps_default = max(summarize_rcd_layout(original_labels, factor_levels, "factor_label", sep)$observed_max_per_column, 1)
    ))
  }

  margins <- if (prefer_margin == "rows") c("rows", "columns") else c("columns", "rows")
  attempts <- list()

  for (mg in margins) {
    part <- find_complete_treatment_partition(
      Dnum = Dnum,
      v = v,
      margin = mg,
      max_solutions_checked = max_solutions_checked
    )
    attempts[[mg]] <- part

    if (part$success) {
      if (mg == "rows") {
        Dnew <- Dnum[part$order, , drop = FALSE]
        row_order <- part$order
        column_order <- seq_len(ncol(Dnum))
        horizontal_default <- 1
        vertical_default <- part$number_of_complete_sets
      } else {
        Dnew <- Dnum[, part$order, drop = FALSE]
        row_order <- seq_len(nrow(Dnum))
        column_order <- part$order
        horizontal_default <- part$number_of_complete_sets
        vertical_default <- 1
      }

      Dlab <- design_numbers_to_factor_labels(Dnew, treatment_map)
      rownames(Dlab) <- paste0("R", seq_len(nrow(Dlab)))
      colnames(Dlab) <- paste0("C", seq_len(ncol(Dlab)))

      return(list(
        reshuffled = TRUE,
        direction = mg,
        message = part$message,
        design = Dlab,
        design_as_numbers = Dnew,
        treatment_map = treatment_map,
        original_analysis = original_analysis,
        row_order = row_order,
        column_order = column_order,
        partition = part,
        attempts = attempts,
        horizontal_reps_default = horizontal_default,
        vertical_reps_default = vertical_default
      ))
    }
  }

  list(
    reshuffled = FALSE,
    direction = "none",
    message = "The generated design is disconnected, but no complete-set row or column reshuffling was found; D2 is the original $design matrix.",
    design = original_labels,
    design_as_numbers = Dnum,
    treatment_map = treatment_map,
    original_analysis = original_analysis,
    row_order = seq_len(nrow(Dnum)),
    column_order = seq_len(ncol(Dnum)),
    partition = NULL,
    attempts = attempts,
    horizontal_reps_default = max(summarize_rcd_layout(original_labels, factor_levels, "factor_label", sep)$observed_max_per_row, 1),
    vertical_reps_default = max(summarize_rcd_layout(original_labels, factor_levels, "factor_label", sep)$observed_max_per_column, 1)
  )
}

#' Generate, check, and optionally repair an MFRCD design
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param levels Integer vector of factor levels.
#' @param block_size Block size used in the construction.
#' @param sep Character separator used in treatment labels.
#' @param use_mixedfact Logical; if TRUE, allow the mixedfact-based construction route.
#' @param mixedfact_method Method passed to mixedfact when that route is used.
#' @param choose_block Rule for choosing a block when several are available.
#' @param group1 Optional integer vector of factor indices in the first group.
#' @param group2 Optional integer vector of factor indices in the second group.
#' @param prefer Construction route preference.
#' @param tol Numerical tolerance.
#' @param repair_if_disconnected Logical; if TRUE, attempt repair when the design is disconnected.
#' @param replication Replication target or "auto".
#' @param horizontal_reps Maximum horizontal replication bound.
#' @param vertical_reps Maximum vertical replication bound.
#' @param max_per_row Maximum allowed occurrences of a treatment in a row.
#' @param max_per_column Maximum allowed occurrences of a treatment in a column.
#' @param max_iter Maximum number of repair iterations.
#' @param max_candidates Maximum number of candidate swaps to examine.
#' @param seed Optional random seed.
#' @param complete_set_prefer Preferred direction for complete-set reshuffling.
#' @param max_complete_set_search Maximum number of complete-set partitions to inspect.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
mfrcd_check_repair <- function(levels,
                               block_size = NULL,
                               sep = "",
                               use_mixedfact = TRUE,
                               mixedfact_method = "auto",
                               choose_block = "best",
                               group1 = NULL,
                               group2 = NULL,
                               prefer = c("auto", "direct", "mixedfact"),
                               tol = 1e-8,
                               repair_if_disconnected = TRUE,
                               replication = "auto",
                               horizontal_reps = NULL,
                               vertical_reps = NULL,
                               max_per_row = NULL,
                               max_per_column = NULL,
                               max_iter = 100,
                               max_candidates = NULL,
                               seed = NULL,
                               complete_set_prefer = c("rows", "columns"),
                               max_complete_set_search = 100000L) {
  prefer <- match.arg(prefer)
  complete_set_prefer <- match.arg(complete_set_prefer)
  levels <- as.integer(levels)

  generated <- mfrcd(
    levels = levels,
    block_size = block_size,
    sep = sep,
    details = TRUE,
    check_properties = TRUE,
    use_mixedfact = use_mixedfact,
    mixedfact_method = mixedfact_method,
    choose_block = choose_block,
    group1 = group1,
    group2 = group2,
    prefer = prefer,
    tol = tol
  )

  generated_design <- extract_design_from_mfrcd_result(generated)

  original_analysis <- analyse_rcd(
    design = generated_design,
    factor_levels = levels,
    input = "factor_label",
    sep = sep,
    tol = tol
  )

  original_properties <- tryCatch(
    verify_mfrcd(generated_design, levels = levels, sep = sep, tol = tol, verbose = FALSE),
    error = function(e) e
  )

  original_summary <- rcd_analysis_summary(original_analysis)

  d2_result <- make_D2_from_complete_sets(
    design = generated_design,
    factor_levels = levels,
    input = "factor_label",
    sep = sep,
    prefer_margin = complete_set_prefer,
    tol = tol,
    max_solutions_checked = max_complete_set_search
  )

  D2 <- d2_result$design

  dimensions <- data.frame(
    rows = nrow(D2),
    columns = ncol(D2),
    treatments = prod(levels),
    total_observations = length(D2),
    stringsAsFactors = FALSE
  )

  layout <- summarize_rcd_layout(
    design = D2,
    factor_levels = levels,
    input = "factor_label",
    sep = sep
  )

  if (is.null(horizontal_reps)) horizontal_reps <- d2_result$horizontal_reps_default
  if (is.null(vertical_reps)) vertical_reps <- d2_result$vertical_reps_default
  if (is.null(max_per_row)) max_per_row <- horizontal_reps
  if (is.null(max_per_column)) max_per_column <- vertical_reps

  before_analysis <- analyse_rcd(
    design = D2,
    factor_levels = levels,
    input = "factor_label",
    sep = sep,
    tol = tol
  )

  before_properties <- tryCatch(
    verify_mfrcd(D2, levels = levels, sep = sep, tol = tol, verbose = FALSE),
    error = function(e) e
  )

  before_summary <- rcd_analysis_summary(before_analysis)

  repair_result <- NULL
  repaired <- FALSE
  after_design <- D2
  after_analysis <- before_analysis
  after_properties <- before_properties
  after_summary <- before_summary

  if (repair_if_disconnected && !before_analysis$connected) {
    repair_result <- make_connected_rcd_bounded(
      design = D2,
      factor_levels = levels,
      input = "factor_label",
      sep = sep,
      tol = tol,
      replication = replication,
      horizontal_reps = horizontal_reps,
      vertical_reps = vertical_reps,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      max_iter = max_iter,
      max_candidates = max_candidates,
      seed = seed,
      verbose = verbose
    )

    if (!is.null(repair_result$repaired_design)) {
      after_design <- repair_result$repaired_design
    }

    after_analysis <- analyse_rcd(
      design = after_design,
      factor_levels = levels,
      input = "factor_label",
      sep = sep,
      tol = tol
    )

    after_properties <- tryCatch(
      verify_mfrcd(after_design, levels = levels, sep = sep, tol = tol, verbose = FALSE),
      error = function(e) e
    )

    after_summary <- rcd_analysis_summary(after_analysis)
    repaired <- !identical(as.vector(D2), as.vector(after_design))
  }

  status <- if (original_analysis$connected) {
    "The generated design is already connected; D2 is the original generated $design matrix."
  } else if (d2_result$reshuffled && !repair_if_disconnected) {
    "The generated design is disconnected; D2 was formed by complete-set reshuffling, and repair was not requested."
  } else if (!d2_result$reshuffled && !repair_if_disconnected) {
    "The generated design is disconnected; no D2 reshuffling was found, and repair was not requested."
  } else if (after_analysis$connected) {
    "The generated design was disconnected; D2 was formed first, then a connected repaired design was found."
  } else {
    "The generated design was disconnected; D2 was formed first, but no connected repaired design was found under the supplied constraints."
  }

  out <- list(
    status = status,
    levels = levels,
    generated = generated,
    generated_design = generated_design,
    original = list(
      design = generated_design,
      analysis = original_analysis,
      properties = original_properties,
      summary = original_summary
    ),
    D2 = D2,
    D2_construction = d2_result,
    dimensions = dimensions,
    layout = layout,
    repair_bounds = data.frame(
      replication = if (identical(replication, "auto")) layout$common_replication else replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      horizontal_reps = horizontal_reps,
      vertical_reps = vertical_reps,
      stringsAsFactors = FALSE
    ),
    before = list(
      design = D2,
      analysis = before_analysis,
      properties = before_properties,
      summary = before_summary
    ),
    repair = repair_result,
    after = list(
      design = after_design,
      analysis = after_analysis,
      properties = after_properties,
      summary = after_summary
    ),
    repaired = repaired,
    changes = cell_changes(D2, after_design)
  )

  class(out) <- "mfrcd_check_repair"
  out
}

#' Print an MFRCD check-and-repair result
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param x An object.
#' @param ... Additional arguments passed to or from methods.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
print.mfrcd_check_repair <- function(x, ...) {
  cat("MFRCD generation, connectedness check, D2 formation, and repair\n")
  cat("-------------------------------------------------------------\n")
  cat(x$status, "\n\n")

  cat("Generated design dimensions used for D2\n")
  print(x$dimensions, row.names = FALSE)

  cat("\nD2 construction\n")
  cat(x$D2_construction$message, "\n")
  cat("Direction:", x$D2_construction$direction, "\n")
  if (!is.null(x$D2_construction$partition)) {
    cat("Complete-set groups:\n")
    print(x$D2_construction$partition$groups)
  }

  cat("\nRepair constraints used\n")
  print(x$repair_bounds, row.names = FALSE)

  cat("\nOriginal generated design\n")
  print(x$original$summary, row.names = FALSE)

  cat("\nD2 before repair\n")
  print(x$before$summary, row.names = FALSE)

  cat("\nAfter repair\n")
  print(x$after$summary, row.names = FALSE)

  if (nrow(x$changes) > 0) {
    cat("\nChanged cells from D2 to repaired design\n")
    print(x$changes, row.names = FALSE)
  }

  invisible(x)
}

# Updated D2 formation and wrapper.
# These definitions override the earlier versions in this file.

#' Compress design labels to observed treatment codes
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
compress_design_to_observed_codes <- function(design,
                                              factor_levels,
                                              input = c("factor_label", "number", "auto"),
                                              sep = "") {
  input <- match.arg(input)

  std <- standardize_factorial_design(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep
  )

  Dfull <- std$design_as_treatment_numbers
  full_map <- std$factorial_treatment_map
  observed_full_ids <- sort(unique(as.integer(Dfull[!is.na(Dfull)])))
  observed_full_ids <- observed_full_ids[!is.na(observed_full_ids)]

  Dcode <- matrix(NA_integer_, nrow = nrow(Dfull), ncol = ncol(Dfull))
  dimnames(Dcode) <- dimnames(Dfull)
  ok <- !is.na(Dfull)
  Dcode[ok] <- match(as.integer(Dfull[ok]), observed_full_ids)

  observed_map <- full_map[observed_full_ids, , drop = FALSE]
  observed_map$full_treatment_no <- observed_full_ids
  observed_map$treatment_no <- seq_along(observed_full_ids)
  rownames(observed_map) <- NULL

  list(
    design_as_codes = Dcode,
    design_as_full_numbers = Dfull,
    observed_map = observed_map,
    full_map = full_map,
    observed_full_ids = observed_full_ids,
    observed_labels = observed_map$factorial_label,
    observed_treatment_count = length(observed_full_ids),
    full_treatment_count = prod(factor_levels),
    all_factorial_treatments_present = length(observed_full_ids) == prod(factor_levels) &&
      setequal(observed_full_ids, seq_len(prod(factor_levels)))
  )
}

#' Convert observed codes back to labels
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dcode Coded design matrix.
#' @param observed_map Map of observed treatments.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
codes_to_observed_labels <- function(Dcode, observed_map) {
  Dlab <- matrix(NA_character_, nrow = nrow(Dcode), ncol = ncol(Dcode))
  dimnames(Dlab) <- dimnames(Dcode)
  ok <- !is.na(Dcode)
  Dlab[ok] <- observed_map$factorial_label[as.integer(Dcode[ok])]
  rownames(Dlab) <- paste0("R", seq_len(nrow(Dlab)))
  colnames(Dlab) <- paste0("C", seq_len(ncol(Dlab)))
  Dlab
}

#' Convert artificial factor labels to codes
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dfake Artificially labeled design.
#' @param vobs Number of observed treatment codes.
#' @param sep Character separator used in treatment labels.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
fake_factor_labels_to_codes <- function(Dfake, vobs, sep = "") {
  standardize_factorial_design(
    design = Dfake,
    factor_levels = c(vobs),
    input = "factor_label",
    sep = sep
  )$design_as_treatment_numbers
}

#' Find complete treatment sets in rows or columns
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param Dnum Numeric design matrix.
#' @param v Function argument.
#' @param target_treatments Treatment set used for complete-set searches.
#' @param margin Margin to search, either rows or columns.
#' @param max_solutions_checked Maximum number of candidate partitions to check.
#' @param allow_repeated_complete_sets Logical; if TRUE, allow repeated complete-set groups.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
find_complete_treatment_partition <- function(Dnum,
                                              v = NULL,
                                              target_treatments = NULL,
                                              margin = c("rows", "columns"),
                                              max_solutions_checked = 100000L,
                                              allow_repeated_complete_sets = TRUE) {
  margin <- match.arg(margin)

  if (is.null(target_treatments)) {
    if (is.null(v)) stop("Supply either v or target_treatments.")
    target_treatments <- seq_len(v)
  }

  target_treatments <- sort(unique(as.integer(target_treatments)))
  target_n <- length(target_treatments)

  if (margin == "rows") {
    n_units <- nrow(Dnum)
    cells_per_unit <- ncol(Dnum)
    get_values <- function(idx) as.integer(Dnum[idx, , drop = FALSE])
  } else {
    n_units <- ncol(Dnum)
    cells_per_unit <- nrow(Dnum)
    get_values <- function(idx) as.integer(Dnum[, idx, drop = FALSE])
  }

  if (cells_per_unit <= 0 || target_n %% cells_per_unit != 0) {
    exact_group_size <- NA_integer_
  } else {
    exact_group_size <- target_n / cells_per_unit
  }

  exact_possible <- !is.na(exact_group_size) &&
    exact_group_size >= 1 &&
    n_units %% exact_group_size == 0

  is_exact_complete_group <- function(idx) {
    vals <- get_values(idx)
    vals <- vals[!is.na(vals)]
    length(vals) == target_n && identical(sort(vals), target_treatments)
  }

  checked <- 0L

  search_partition <- function(remaining, groups, group_size, group_ok) {
    if (length(remaining) == 0) return(groups)
    if (checked > max_solutions_checked) return(NULL)

    first <- remaining[1]

    if (group_size == 1) {
      candidate_groups <- list(first)
    } else {
      others <- remaining[-1]
      if (length(others) < group_size - 1) return(NULL)
      candidate_groups <- combn(others, group_size - 1, simplify = FALSE)
      candidate_groups <- lapply(candidate_groups, function(z) c(first, z))
    }

    for (g in candidate_groups) {
      checked <<- checked + 1L
      if (checked > max_solutions_checked) return(NULL)

      if (group_ok(g)) {
        next_remaining <- setdiff(remaining, g)
        ans <- search_partition(next_remaining, c(groups, list(g)), group_size, group_ok)
        if (!is.null(ans)) return(ans)
      }
    }

    NULL
  }

  if (exact_possible) {
    checked <- 0L
    groups <- search_partition(
      remaining = seq_len(n_units),
      groups = list(),
      group_size = exact_group_size,
      group_ok = is_exact_complete_group
    )

    if (!is.null(groups)) {
      return(list(
        success = TRUE,
        margin = margin,
        group_size = exact_group_size,
        number_of_complete_sets = length(groups),
        groups = groups,
        order = unlist(groups, use.names = FALSE),
        checked = checked,
        target_treatments = target_treatments,
        target_treatment_count = target_n,
        complete_set_type = "exact_once",
        message = paste0("The ", margin,
                         " were reordered into consecutive complete treatment sets.")
      ))
    }
  }

  if (allow_repeated_complete_sets) {
    min_group_size <- max(1L, ceiling(target_n / cells_per_unit))
    possible_group_sizes <- seq.int(min_group_size, n_units)
    possible_group_sizes <- possible_group_sizes[n_units %% possible_group_sizes == 0]

    is_repeated_complete_group <- function(idx) {
      vals <- get_values(idx)
      vals <- vals[!is.na(vals)]
      all(vals %in% target_treatments) && setequal(unique(vals), target_treatments)
    }

    for (gs in possible_group_sizes) {
      checked <- 0L
      groups <- search_partition(
        remaining = seq_len(n_units),
        groups = list(),
        group_size = gs,
        group_ok = is_repeated_complete_group
      )

      if (!is.null(groups)) {
        return(list(
          success = TRUE,
          margin = margin,
          group_size = gs,
          number_of_complete_sets = length(groups),
          groups = groups,
          order = unlist(groups, use.names = FALSE),
          checked = checked,
          target_treatments = target_treatments,
          target_treatment_count = target_n,
          complete_set_type = "contains_all_target_treatments",
          message = paste0("The ", margin,
                           " were reordered into consecutive complete treatment sets. ",
                           "Each complete set contains all target treatments, allowing repeats.")
        ))
      }
    }
  }

  list(
    success = FALSE,
    margin = margin,
    group_size = if (exists("exact_group_size")) exact_group_size else NA_integer_,
    checked = checked,
    target_treatments = target_treatments,
    target_treatment_count = target_n,
    message = paste0("No partition of ", margin,
                     " into complete treatment sets was found.")
  )
}

#' Create a D2 design from complete treatment sets
#'
#' Create a D2 design from complete treatment sets.
#'
#' @param design A row-column design matrix.
#' @param factor_levels Integer vector of factor levels.
#' @param input Coding used by the supplied design.
#' @param sep Character separator used in treatment labels.
#' @param prefer_margin Preferred margin for complete-set reshuffling.
#' @param tol Numerical tolerance.
#' @param max_solutions_checked Maximum number of candidate partitions to check.
#' @param treatment_universe Treatment universe used for connectedness and repair.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' D <- mfrcd(c(2, 2))
#' res <- make_D2_from_complete_sets(D, factor_levels = c(2, 2))
#' stopifnot(is.list(res))
make_D2_from_complete_sets <- function(design,
                                       factor_levels,
                                       input = c("factor_label", "number", "auto"),
                                       sep = "",
                                       prefer_margin = c("rows", "columns"),
                                       tol = 1e-8,
                                       max_solutions_checked = 100000L,
                                       treatment_universe = c("auto", "factorial", "observed")) {
  input <- match.arg(input)
  prefer_margin <- match.arg(prefer_margin)
  treatment_universe <- match.arg(treatment_universe)

  comp <- compress_design_to_observed_codes(
    design = design,
    factor_levels = factor_levels,
    input = input,
    sep = sep
  )

  Dfull <- comp$design_as_full_numbers
  full_map <- comp$full_map
  original_labels <- design_numbers_to_factor_labels(Dfull, full_map)

  full_v <- comp$full_treatment_count
  obs_v <- comp$observed_treatment_count

  if (treatment_universe == "auto") {
    use_observed <- !comp$all_factorial_treatments_present
  } else {
    use_observed <- treatment_universe == "observed"
  }

  if (use_observed) {
    target_treatments <- comp$observed_full_ids
    universe_label <- "observed_in_generated_design"
    analysis_design <- comp$design_as_codes
    analysis_levels <- c(obs_v)
    analysis_input <- "number"
  } else {
    target_treatments <- seq_len(full_v)
    universe_label <- "full_factorial"
    analysis_design <- original_labels
    analysis_levels <- factor_levels
    analysis_input <- "factor_label"
  }

  original_analysis <- analyse_rcd(
    design = analysis_design,
    factor_levels = analysis_levels,
    input = analysis_input,
    sep = if (use_observed) "" else sep,
    tol = tol
  )

  universe_note <- if (use_observed) {
    paste0("Only ", obs_v, " of ", full_v,
           " factorial treatment labels occur in the generated design; ",
           "complete-set reshuffling and repair therefore use the observed treatment set.")
  } else {
    paste0("All ", full_v, " factorial treatments occur; complete-set reshuffling uses the full factorial treatment set.")
  }

  if (original_analysis$connected) {
    layout0 <- if (use_observed) {
      summarize_rcd_layout(analysis_design, c(obs_v), "number", "")
    } else {
      summarize_rcd_layout(original_labels, factor_levels, "factor_label", sep)
    }

    return(list(
      reshuffled = FALSE,
      direction = "none",
      message = paste0("The original generated design is connected; D2 is the original $design matrix. ",
                       universe_note),
      design = original_labels,
      design_as_numbers = if (use_observed) comp$design_as_codes else Dfull,
      design_as_full_numbers = Dfull,
      treatment_map = if (use_observed) comp$observed_map else full_map,
      full_treatment_map = full_map,
      observed_treatment_map = comp$observed_map,
      treatment_universe = universe_label,
      target_treatments = target_treatments,
      original_analysis = original_analysis,
      row_order = seq_len(nrow(Dfull)),
      column_order = seq_len(ncol(Dfull)),
      partition = NULL,
      horizontal_reps_default = max(layout0$observed_max_per_row, 1),
      vertical_reps_default = max(layout0$observed_max_per_column, 1)
    ))
  }

  margins <- if (prefer_margin == "rows") c("rows", "columns") else c("columns", "rows")
  attempts <- list()

  for (mg in margins) {
    part <- find_complete_treatment_partition(
      Dnum = Dfull,
      target_treatments = target_treatments,
      margin = mg,
      max_solutions_checked = max_solutions_checked
    )
    attempts[[mg]] <- part

    if (part$success) {
      if (mg == "rows") {
        Dnew_full <- Dfull[part$order, , drop = FALSE]
        row_order <- part$order
        column_order <- seq_len(ncol(Dfull))
        horizontal_default <- 1
        vertical_default <- part$number_of_complete_sets
      } else {
        Dnew_full <- Dfull[, part$order, drop = FALSE]
        row_order <- seq_len(nrow(Dfull))
        column_order <- part$order
        horizontal_default <- part$number_of_complete_sets
        vertical_default <- 1
      }

      Dlab <- design_numbers_to_factor_labels(Dnew_full, full_map)
      rownames(Dlab) <- paste0("R", seq_len(nrow(Dlab)))
      colnames(Dlab) <- paste0("C", seq_len(ncol(Dlab)))

      if (use_observed) {
        Dnew_numbers <- matrix(match(as.integer(Dnew_full), comp$observed_full_ids),
                               nrow = nrow(Dnew_full), ncol = ncol(Dnew_full))
        dimnames(Dnew_numbers) <- dimnames(Dlab)
      } else {
        Dnew_numbers <- Dnew_full
      }

      return(list(
        reshuffled = TRUE,
        direction = mg,
        message = paste0(part$message, " ", universe_note),
        design = Dlab,
        design_as_numbers = Dnew_numbers,
        design_as_full_numbers = Dnew_full,
        treatment_map = if (use_observed) comp$observed_map else full_map,
        full_treatment_map = full_map,
        observed_treatment_map = comp$observed_map,
        treatment_universe = universe_label,
        target_treatments = target_treatments,
        original_analysis = original_analysis,
        row_order = row_order,
        column_order = column_order,
        partition = part,
        attempts = attempts,
        horizontal_reps_default = horizontal_default,
        vertical_reps_default = vertical_default
      ))
    }
  }

  layout0 <- if (use_observed) {
    summarize_rcd_layout(comp$design_as_codes, c(obs_v), "number", "")
  } else {
    summarize_rcd_layout(original_labels, factor_levels, "factor_label", sep)
  }

  list(
    reshuffled = FALSE,
    direction = "none",
    message = paste0("The generated design is disconnected, but no complete-set row or column reshuffling was found; D2 is the original $design matrix. ",
                     universe_note),
    design = original_labels,
    design_as_numbers = if (use_observed) comp$design_as_codes else Dfull,
    design_as_full_numbers = Dfull,
    treatment_map = if (use_observed) comp$observed_map else full_map,
    full_treatment_map = full_map,
    observed_treatment_map = comp$observed_map,
    treatment_universe = universe_label,
    target_treatments = target_treatments,
    original_analysis = original_analysis,
    row_order = seq_len(nrow(Dfull)),
    column_order = seq_len(ncol(Dfull)),
    partition = NULL,
    attempts = attempts,
    horizontal_reps_default = max(layout0$observed_max_per_row, 1),
    vertical_reps_default = max(layout0$observed_max_per_column, 1)
  )
}
#' Emit an optional progress message
#'
#'
#' Internal helper used by the MFRCD construction and analysis routines.
#'
#' @param .time Logical; if TRUE, include a timestamp.
#'
#' @return Internal helper return value.
#' @keywords internal
#' @noRd
progress_msg <- function(..., .time = TRUE) {
  txt <- paste0(...)
  if (.time) {
    txt <- paste0(format(Sys.time(), "%H:%M:%S"), " | ", txt)
  }
  message(txt)
}

#' Generate, check, and optionally repair an MFRCD design
#'
#' Generate, check, and optionally repair an MFRCD design.
#'
#' @param levels Integer vector of factor levels.
#' @param block_size Block size used in the construction.
#' @param sep Character separator used in treatment labels.
#' @param use_mixedfact Logical; if TRUE, allow the mixedfact-based construction route.
#' @param mixedfact_method Method passed to mixedfact when that route is used.
#' @param choose_block Rule for choosing a block when several are available.
#' @param group1 Optional integer vector of factor indices in the first group.
#' @param group2 Optional integer vector of factor indices in the second group.
#' @param prefer Construction route preference.
#' @param tol Numerical tolerance.
#' @param repair_if_disconnected Logical; if TRUE, attempt repair when the design is disconnected.
#' @param replication Replication target or "auto".
#' @param horizontal_reps Maximum horizontal replication bound.
#' @param vertical_reps Maximum vertical replication bound.
#' @param max_per_row Maximum allowed occurrences of a treatment in a row.
#' @param max_per_column Maximum allowed occurrences of a treatment in a column.
#' @param max_iter Maximum number of repair iterations.
#' @param max_candidates Maximum number of candidate swaps to examine.
#' @param seed Optional random seed.
#' @param complete_set_prefer Preferred direction for complete-set reshuffling.
#' @param max_complete_set_search Maximum number of complete-set partitions to inspect.
#' @param treatment_universe Treatment universe used for connectedness and repair.
#' @param verbose Logical; if TRUE, emit progress or summary messages.
#'
#' @return A list, matrix, data frame, or classed object containing the requested row-column design information.
#' @export
#'
#' @examples
#' res <- mfrcd_check_repair(c(2, 2), repair_if_disconnected = FALSE, max_iter = 1, max_candidates = 5)
#' stopifnot(inherits(res, "mfrcd_check_repair"))
mfrcd_check_repair <- function(levels,
                               block_size = NULL,
                               sep = "",
                               use_mixedfact = TRUE,
                               mixedfact_method = "auto",
                               choose_block = "best",
                               group1 = NULL,
                               group2 = NULL,
                               prefer = c("auto", "direct", "mixedfact"),
                               tol = 1e-8,
                               repair_if_disconnected = TRUE,
                               replication = "auto",
                               horizontal_reps = NULL,
                               vertical_reps = NULL,
                               max_per_row = NULL,
                               max_per_column = NULL,
                               max_iter = 100,
                               max_candidates = NULL,
                               seed = NULL,
                               complete_set_prefer = c("rows", "columns"),
                               max_complete_set_search = 100000L,
                               treatment_universe = c("auto", "factorial", "observed"),
                               verbose = FALSE) {
  prefer <- match.arg(prefer)
  complete_set_prefer <- match.arg(complete_set_prefer)
  treatment_universe <- match.arg(treatment_universe)
  levels <- as.integer(levels)

  generated <- mfrcd(
    levels = levels,
    block_size = block_size,
    sep = sep,
    details = TRUE,
    check_properties = TRUE,
    use_mixedfact = use_mixedfact,
    mixedfact_method = mixedfact_method,
    choose_block = choose_block,
    group1 = group1,
    group2 = group2,
    prefer = prefer,
    tol = tol
  )

  generated_design <- extract_design_from_mfrcd_result(generated)

  d2_result <- make_D2_from_complete_sets(
    design = generated_design,
    factor_levels = levels,
    input = "factor_label",
    sep = sep,
    prefer_margin = complete_set_prefer,
    tol = tol,
    max_solutions_checked = max_complete_set_search,
    treatment_universe = treatment_universe
  )

  D2 <- d2_result$design
  use_observed <- identical(d2_result$treatment_universe, "observed_in_generated_design")

  if (use_observed) {
    analysis_levels <- c(nrow(d2_result$observed_treatment_map))
    original_analysis <- d2_result$original_analysis
    original_properties <- NULL
    D2_analysis_design <- d2_result$design_as_numbers
    D2_analysis_input <- "number"
    D2_analysis_sep <- ""
  } else {
    analysis_levels <- levels
    original_analysis <- d2_result$original_analysis
    original_properties <- tryCatch(
      verify_mfrcd(generated_design, levels = levels, sep = sep, tol = tol, verbose = FALSE),
      error = function(e) e
    )
    D2_analysis_design <- D2
    D2_analysis_input <- "factor_label"
    D2_analysis_sep <- sep
  }

  original_summary <- rcd_analysis_summary(original_analysis)

  dimensions <- data.frame(
    rows = nrow(D2),
    columns = ncol(D2),
    treatments_used_for_analysis = if (use_observed) nrow(d2_result$observed_treatment_map) else prod(levels),
    full_factorial_treatments = prod(levels),
    total_observations = length(D2),
    stringsAsFactors = FALSE
  )

  layout <- summarize_rcd_layout(
    design = D2_analysis_design,
    factor_levels = analysis_levels,
    input = D2_analysis_input,
    sep = D2_analysis_sep
  )

  if (is.null(horizontal_reps)) horizontal_reps <- d2_result$horizontal_reps_default
  if (is.null(vertical_reps)) vertical_reps <- d2_result$vertical_reps_default
  if (is.null(max_per_row)) max_per_row <- horizontal_reps
  if (is.null(max_per_column)) max_per_column <- vertical_reps

  before_analysis <- analyse_rcd(
    design = D2_analysis_design,
    factor_levels = analysis_levels,
    input = D2_analysis_input,
    sep = D2_analysis_sep,
    tol = tol
  )

  before_properties <- if (use_observed) {
    NULL
  } else {
    tryCatch(
      verify_mfrcd(D2, levels = levels, sep = sep, tol = tol, verbose = FALSE),
      error = function(e) e
    )
  }

  before_summary <- rcd_analysis_summary(before_analysis)

  repair_result <- NULL
  repaired <- FALSE
  after_design <- D2
  after_analysis_design <- D2_analysis_design
  after_analysis <- before_analysis
  after_properties <- before_properties
  after_summary <- before_summary

  if (repair_if_disconnected && !before_analysis$connected) {
    repair_result <- make_connected_rcd_bounded(
      design = D2_analysis_design,
      factor_levels = analysis_levels,
      input = D2_analysis_input,
      sep = D2_analysis_sep,
      tol = tol,
      replication = replication,
      horizontal_reps = horizontal_reps,
      vertical_reps = vertical_reps,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      max_iter = max_iter,
      max_candidates = max_candidates,
      seed = seed,
      verbose = verbose
    )

    if (use_observed) {
      if (!is.null(repair_result$repaired_design)) {
        after_analysis_design <- fake_factor_labels_to_codes(
          repair_result$repaired_design,
          vobs = analysis_levels[1],
          sep = ""
        )
        after_design <- codes_to_observed_labels(
          after_analysis_design,
          d2_result$observed_treatment_map
        )
      }
    } else {
      if (!is.null(repair_result$repaired_design)) {
        after_design <- repair_result$repaired_design
        after_analysis_design <- after_design
      }
    }

    after_analysis <- analyse_rcd(
      design = after_analysis_design,
      factor_levels = analysis_levels,
      input = D2_analysis_input,
      sep = D2_analysis_sep,
      tol = tol
    )

    after_properties <- if (use_observed) {
      NULL
    } else {
      tryCatch(
        verify_mfrcd(after_design, levels = levels, sep = sep, tol = tol, verbose = FALSE),
        error = function(e) e
      )
    }

    after_summary <- rcd_analysis_summary(after_analysis)
    repaired <- !identical(as.vector(D2), as.vector(after_design))
  }

  status <- if (original_analysis$connected) {
    "The generated design is already connected; D2 is the original generated $design matrix."
  } else if (d2_result$reshuffled && !repair_if_disconnected) {
    "The generated design is disconnected; D2 was formed by complete-set reshuffling, and repair was not requested."
  } else if (!d2_result$reshuffled && !repair_if_disconnected) {
    "The generated design is disconnected; no D2 reshuffling was found, and repair was not requested."
  } else if (after_analysis$connected) {
    "The generated design was disconnected; D2 was formed first, then a connected repaired design was found."
  } else {
    "The generated design was disconnected; D2 was formed first, but no connected repaired design was found under the supplied constraints."
  }

  if (use_observed) {
    status <- paste0(status, " Analysis/repair used the observed treatment set because the generated design does not contain all factorial treatment labels.")
  }

  out <- list(
    status = status,
    levels = levels,
    treatment_universe = d2_result$treatment_universe,
    generated = generated,
    generated_design = generated_design,
    original = list(
      design = generated_design,
      analysis = original_analysis,
      properties = original_properties,
      summary = original_summary
    ),
    D2 = D2,
    D2_construction = d2_result,
    dimensions = dimensions,
    layout = layout,
    repair_bounds = data.frame(
      replication = if (identical(replication, "auto")) layout$common_replication else replication,
      max_per_row = max_per_row,
      max_per_column = max_per_column,
      horizontal_reps = horizontal_reps,
      vertical_reps = vertical_reps,
      stringsAsFactors = FALSE
    ),
    before = list(
      design = D2,
      analysis = before_analysis,
      properties = before_properties,
      summary = before_summary
    ),
    repair = repair_result,
    after = list(
      design = after_design,
      analysis = after_analysis,
      properties = after_properties,
      summary = after_summary
    ),
    repaired = repaired,
    changes = cell_changes(D2, after_design)
  )

  class(out) <- "mfrcd_check_repair"
  out
}

#' Print an MFRCD check-and-repair result
#'
#' Print an MFRCD check-and-repair result.
#'
#' @param x An object.
#' @param ... Additional arguments passed to or from methods.
#'
#' @return Invisibly returns `x`.
#' @method print mfrcd_check_repair
#' @export
#'
#' @examples
#' res <- mfrcd_check_repair(c(2, 2), repair_if_disconnected = FALSE, max_iter = 1, max_candidates = 5)
#' print(res)
print.mfrcd_check_repair <- function(x, ...) {
  cat("MFRCD generation, connectedness check, D2 formation, and repair\n")
  cat("-------------------------------------------------------------\n")
  cat(x$status, "\n\n")

  cat("Treatment universe used for connectedness and repair\n")
  cat(x$treatment_universe, "\n\n")

  cat("Generated design dimensions used for D2\n")
  print(x$dimensions, row.names = FALSE)

  cat("\nD2 construction\n")
  cat(x$D2_construction$message, "\n")
  cat("Direction:", x$D2_construction$direction, "\n")
  if (!is.null(x$D2_construction$partition)) {
    cat("Complete-set groups:\n")
    print(x$D2_construction$partition$groups)
  }
  cat("\nRepair constraints used\n")
  print(x$repair_bounds, row.names = FALSE)

  cat("\nOriginal generated design\n")
  print(x$original$summary, row.names = FALSE)

  cat("\nD2 before repair\n")
  print(x$before$summary, row.names = FALSE)

  cat("\nAfter repair\n")
  print(x$after$summary, row.names = FALSE)

  if (nrow(x$changes) > 0) {
    cat("\nChanged cells from D2 to repaired design\n")
    print(x$changes, row.names = FALSE)
  }

  invisible(x)
}
