#' GRCFE: Generate row-column factorial experiments
#'
#' Tools for constructing row-column factorial experiment layouts for estimating
#' main effects and two-factor interactions. The main entry point is
#' \code{generate_2fi_rowcol()}, which chooses theorem-based, heuristic, or
#' search-based construction depending on the number of factor levels and the
#' requested fraction size.
#'
#' @section Design notation:
#' Let \code{s} be the number of levels, \code{p} the number of row blocking
#' factors, \code{q} the number of column blocking factors, and \code{n} the
#' number of treatment factors. The run size is \code{s^(p + q)} and
#' \code{k = n - (p + q)} indicates the degree of fractionation used by the
#' construction wrappers.
#'
#' @docType package
#' @name GRCFE-package
#' @aliases GRCFE
#' @keywords internal
"_PACKAGE"


#' Generate a 2FI-optimal row-column factorial design
#'
#' Constructs a row-column design for estimating main effects and two-factor
#' interactions (2FIs). For prime \code{s}, theorem-based generator matrices are
#' used when available. For composite \code{s}, and for the full two-level case,
#' the function falls back to a D-optimality heuristic.
#'
#' @param s Integer. Number of levels for each treatment factor. Must be at
#'   least 2.
#' @param p Integer. Number of row blocking factors; rows are indexed by
#'   \code{s^p} combinations.
#' @param q Integer. Number of column blocking factors; columns are indexed by
#'   \code{s^q} combinations.
#' @param n Integer. Number of treatment factors. Defaults to \code{p + q}.
#' @param max_iter_nonprime Integer. Maximum coordinate-exchange iterations per
#'   heuristic start for non-prime or unsupported cases.
#' @param n_starts_nonprime Integer. Number of random heuristic starts.
#' @param verbose_nonprime Logical. If \code{TRUE}, reports heuristic progress
#'   using \code{message()}. The default is \code{FALSE}.
#'
#' @return A list with components \code{s}, \code{p}, \code{q}, \code{n},
#'   \code{G}, \code{design}, and construction metadata. For theorem-based
#'   designs, \code{G} is the generator matrix. For heuristic designs,
#'   \code{G = NULL} and \code{D_opt_objective} is included.
#'
#' @details
#' The function supports \code{p + q <= n}. The heuristic path currently supports
#' \code{k = n - (p + q)} in \code{0:3}. The theorem-based path supports prime
#' \code{s} when the corresponding generator-matrix construction is implemented.
#'
#' @references
#' Zhang, Y., Pan, J. and Shi, L. (2025).
#' Construction of 2fi-optimal row-column designs.
#' \emph{Journal of Statistical Planning and Inference}, 234, 106192.
#' ISSN 0378-3758.
#' \doi{10.1016/j.jspi.2024.106192}
#' @examples
#' res <- generate_2fi_optimal_rowcol(s = 3, p = 1, q = 1, n = 2)
#' head(res$design)
#' stopifnot(nrow(res$design) == 3^(1 + 1))
#'
#' @seealso \code{\link{generate_2fi_rowcol}}, \code{\link{build_G}}
#' @export
generate_2fi_optimal_rowcol <- function(s, p, q,
                                        n = p + q,
                                        max_iter_nonprime = 5000,
                                        n_starts_nonprime = 5,
                                        verbose_nonprime  = FALSE) {
  s <- as.integer(s)
  if (s < 2) stop("s must be at least 2 levels.")

  r <- p + q
  if (r > n) {
    stop("Need p + q <= n. You gave p=", p,
         ", q=", q, ", n=", n, ".")
  }
  k <- n - r

  prime_flag <- is_prime(s)

  if (prime_flag && !(s == 2 && n == p + q && k == 0)) {
    G_obj <- generate_row_column_design(build_G(s, p, q, n), s, p, q)
    G_obj$heuristic <- FALSE
    G_obj$k <- k
    return(G_obj)
  }

 if (!(k %in% 0:3)) {
    stop("Heuristic path currently supports only k = 0,1,2,3. Here k = ", k, ".")
  }

  heuristic_rowcol_composite(
    s        = s,
    p        = p,
    q        = q,
    n        = n,
    max_iter = max_iter_nonprime,
    n_starts = n_starts_nonprime,
    verbose  = verbose_nonprime
  )
}


#' Test whether an integer is prime
#'
#' @param s Integer value to test.
#'
#' @return Logical scalar. \code{TRUE} if \code{s} is prime and \code{FALSE}
#'   otherwise.
#'
#' @keywords internal
is_prime <- function(s) {
  s <- as.integer(s)
  if (s < 2) return(FALSE)
  if (s == 2) return(TRUE)
  if (s %% 2 == 0) return(FALSE)
  lim <- floor(sqrt(s))
  if (lim < 3) return(TRUE)  # covers s = 3 correctly
  for (k in seq.int(3, lim, by = 2)) {
    if (s %% k == 0) return(FALSE)
  }
  TRUE
}

#' Compute a D-optimality aliasing objective
#'
#' Computes the negative log determinant of the information matrix for a
#' row-column model containing row effects, column effects, main effects, and all
#' two-factor treatment interactions.
#'
#' @param design_mat Matrix or data frame. The first two columns are row and
#'   column indices; remaining columns are treatment-factor levels.
#' @param s Integer. Number of levels per treatment factor.
#'
#' @return Numeric scalar. Smaller values indicate better D-optimality. Returns
#'   \code{Inf} if the regularized information matrix is not positive definite.
#'
#' @importFrom stats as.formula model.matrix
#' @keywords internal
alias_objective_Dopt <- function(design_mat, s) {
  # design_mat: columns: row, col, then n treatment cols
  design_mat <- as.data.frame(design_mat)
  colnames(design_mat)[1:2] <- c("row", "col")
  n <- ncol(design_mat) - 2

  df <- data.frame(
    row = factor(design_mat$row),
    col = factor(design_mat$col)
  )
  for (j in 1:n) {
    df[[paste0("F", j)]] <-
      factor(design_mat[[2 + j]], levels = 0:(s - 1))
  }

  old_contr <- options(contrasts = c("contr.sum", "contr.poly"))
  on.exit(options(old_contr), add = TRUE)

  f_str <- paste0("~ row + col + (",
                  paste(paste0("F", 1:n), collapse = " + "),
                  ")^2")
  mm <- model.matrix(as.formula(f_str), data = df)
  X  <- mm[, -1, drop = FALSE]

  XtX <- crossprod(X)
  XtX <- XtX + diag(1e-8, nrow(XtX))
  eig <- eigen(XtX, symmetric = TRUE, only.values = TRUE)$values
  if (any(eig <= 0)) return(Inf)

  -sum(log(eig))  # negative log det: smaller is better
}

#' Generate a row-column design for main effects and two-factor interactions
#'
#' Main user-facing wrapper for generating row-column factorial layouts. The
#' function automatically chooses between theorem-based constructions,
#' heuristic D-optimal search, and random generator-matrix search depending on
#' \code{s}, \code{p}, \code{q}, \code{n}, and \code{mode}.
#'
#' @param s Integer. Number of levels for each treatment factor. Must be at
#'   least 2.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#' @param n Integer. Number of treatment factors. Must satisfy \code{p + q <= n}.
#' @param mode Character. One of \code{"auto"}, \code{"theorem"}, or
#'   \code{"search"}. \code{"auto"} uses theorem/heuristic construction for
#'   \code{k = 0,1} and search for prime-level \code{k = 2,3} cases.
#' @param max_iter_nonprime Integer. Maximum heuristic iterations per start for
#'   composite-level or unsupported theorem cases.
#' @param n_starts_nonprime Integer. Number of random heuristic starts.
#' @param verbose_nonprime Logical. If \code{TRUE}, reports heuristic progress
#'   using \code{message()}. The default is \code{FALSE}.
#' @param max_tries_search Integer. Maximum random generator matrices to try in
#'   search mode.
#' @param N_max_runs_search Integer. Maximum allowed number of runs for search.
#' @param verbose_search Logical. If \code{TRUE}, reports improvements found by
#'   the search routine using \code{message()}. The default is \code{FALSE} so
#'   the function is quiet in normal package use and during examples/tests.
#'
#' @return A list containing the generated design and associated construction
#'   information. The \code{design} component is a data frame with columns
#'   \code{Row}, \code{Col}, and treatment factors \code{F1}, \code{F2}, ...,
#'   \code{Fn}.
#'
#' @details
#' Let \code{k = n - (p + q)}. For non-prime \code{s}, this wrapper currently
#' supports \code{k} in \code{0:3} through the heuristic path. For prime \code{s},
#' theorem mode is available for \code{k = 0} or \code{k = 1}; search mode is
#' intended for \code{k = 2} or \code{k = 3}.
#'
#' @examples
#' # A small theorem-based row-column layout using the auto wrapper
#' res <- generate_2fi_rowcol(s = 3, p = 1, q = 1, n = 2, mode = "auto")
#' dim(res$design)
#' head(res$design)
#' stopifnot(is.data.frame(res$design))
#'
#' @seealso \code{\link{generate_2fi_optimal_rowcol}},
#'   \code{\link{search_2fi_optimal_G_k23}}, \code{\link{eval_2fi_from_design}}
#' @export
generate_2fi_rowcol <- function(
    s, p, q, n,
    mode = c("auto", "theorem", "search"),
    max_iter_nonprime = 5000,
    n_starts_nonprime = 5,
    verbose_nonprime  = FALSE,
    max_tries_search  = 5000,
    N_max_runs_search = 10000,
    verbose_search    = FALSE
) {
  mode <- match.arg(mode)
  s    <- as.integer(s)
  r    <- p + q

  if (r > n) {
    stop("Need p + q <= n. You gave p = ", p, ", q = ", q, ", n = ", n, ".")
  }
  k <- n - r
  if (s < 2) stop("s must be at least 2 levels.")

  prime_flag <- is_prime(s)

  ## ---------- NON-PRIME s: heuristic for k = 0..3 ----------
  if (!prime_flag) {
    if (mode == "search") {
      stop("Search mode is only implemented for prime s (2,3,5,7). ",
           "You gave s = ", s, ", which is composite.")
    }
    if (!(k %in% 0:3)) {
      stop("For non-prime s, this wrapper currently supports only k = 0,1,2,3. ",
           "Here k = n - (p+q) = ", k, ".")
    }

    return(
      generate_2fi_optimal_rowcol(
        s = s, p = p, q = q, n = n,
        max_iter_nonprime = max_iter_nonprime,
        n_starts_nonprime = n_starts_nonprime,
        verbose_nonprime  = verbose_nonprime
      )
    )
  }

  ## ---------- PRIME s ----------
  if (mode == "theorem") {
    if (!(k %in% c(0, 1))) {
      stop("Theorem mode only valid for k = 0 (full factorial) or k = 1 (one-replicate fraction). ",
           "Here k = ", k, ".")
    }
    return(
      generate_2fi_optimal_rowcol(
        s = s, p = p, q = q, n = n,
        max_iter_nonprime = max_iter_nonprime,
        n_starts_nonprime = n_starts_nonprime,
        verbose_nonprime  = verbose_nonprime
      )
    )
  }

  if (mode == "search") {
    if (!(k %in% c(2, 3))) {
      stop("Search mode here is intended for k = 2 or 3. Here k = ", k, ".")
    }
    return(
      search_2fi_optimal_G_k23(
        s          = s,
        p          = p,
        q          = q,
        n          = n,
        max_tries  = max_tries_search,
        N_max_runs = N_max_runs_search,
        verbose    = verbose_search
      )
    )
  }

  ## mode == "auto"
  if (k %in% c(0, 1)) {
    return(
      generate_2fi_optimal_rowcol(
        s = s, p = p, q = q, n = n,
        max_iter_nonprime = max_iter_nonprime,
        n_starts_nonprime = n_starts_nonprime,
        verbose_nonprime  = verbose_nonprime
      )
    )
  }
  if (k %in% c(2, 3)) {
    return(
      search_2fi_optimal_G_k23(
        s          = s,
        p          = p,
        q          = q,
        n          = n,
        max_tries  = max_tries_search,
        N_max_runs = N_max_runs_search,
        verbose    = verbose_search
      )
    )
  }

  stop("Wrapper currently supports k = n - (p+q) in {0,1,2,3}. Here k = ", k, ".")
}


#' Reduce values modulo s
#'
#' @param x Numeric vector, matrix, or array.
#' @param s Integer modulus.
#'
#' @return \code{x} reduced to the range \code{0, ..., s - 1}.
#'
#' @keywords internal
modp <- function(x, s) ((x %% s) + s) %% s


#' Multiplicative inverse in GF(s)
#'
#' @param a Integer scalar.
#' @param s Prime modulus.
#'
#' @return Integer scalar giving the multiplicative inverse of \code{a} modulo
#'   \code{s}.
#'
#' @keywords internal
inv_mod_scalar <- function(a, s) {
  a <- modp(a, s)
  if (a == 0) stop("No inverse for 0 in GF(s).")
  for (k in 1:(s - 1)) {
    if (modp(a * k, s) == 1) return(k)
  }
  stop("No multiplicative inverse found (should not happen for prime s).")
}


#' Canonicalize a projective-space vector
#'
#' Scales a nonzero vector over \code{GF(s)} so that its first nonzero entry is
#' equal to 1.
#'
#' @param v Numeric vector.
#' @param s Prime modulus.
#'
#' @return Integer vector in canonical projective form.
#'
#' @keywords internal
canonicalize_vec <- function(v, s) {
  v <- modp(v, s)
  if (all(v == 0)) stop("Zero vector cannot be canonicalized.")
  first <- which(v != 0)[1]
  inv   <- inv_mod_scalar(v[first], s)
  modp(v * inv, s)
}


#' Generate projective-space points over GF(s)
#'
#' @param d Integer. Vector-space dimension.
#' @param s Prime modulus.
#'
#' @return Matrix whose rows are canonical representatives of the points in
#'   \code{PG(d - 1, s)}.
#'
#' @keywords internal
generate_pg_points <- function(d, s) {
  if (d <= 0) stop("Dimension d must be >= 1.")
  grids <- as.matrix(expand.grid(rep(list(0:(s - 1)), d)))
  grids <- grids[rowSums(grids != 0) > 0, , drop = FALSE]
  canon_mat <- t(apply(grids, 1, canonicalize_vec, s = s))
  df <- unique(as.data.frame(canon_mat))
  as.matrix(df)
}


#' Extend a base generator matrix using projective-space points
#'
#' Adds projective-space columns so that generator-column multiplicities satisfy
#' the near-balanced requirements used by the implemented theorem-based
#' constructions.
#'
#' @param base Matrix or vector of existing generator columns.
#' @param d Integer. Projective-space dimension.
#' @param s Prime modulus.
#' @param n_total Integer. Total number of generator columns required.
#'
#' @return Matrix of additional generator columns. May have zero columns if no
#'   extension is needed.
#'
#' @keywords internal
extend_with_pg_points <- function(base, d, s, n_total) {
  pts <- generate_pg_points(d, s)
  L   <- nrow(pts)
  denom <- (s^d - 1)
  alpha <- floor(n_total * (s - 1) / denom)

  pt_keys <- apply(pts, 1, function(v) paste(v, collapse = ","))

  base_counts <- integer(L)
  if (!is.null(base) && length(base) > 0) {
    if (is.vector(base)) base <- matrix(base, nrow = d)
    for (j in 1:ncol(base)) {
      v_can <- canonicalize_vec(base[, j], s)
      key   <- paste(v_can, collapse = ",")
      idx   <- match(key, pt_keys)
      if (is.na(idx)) {
        stop("Base column not found in PG(d-1,s); check construction.")
      }
      base_counts[idx] <- base_counts[idx] + 1L
    }
  }

  t <- pmax(base_counts, alpha)
  if (any(t > alpha + 1L)) {
    stop("Base multiplicities exceed alpha+1 for some projective points; ",
         "this parameter/template combo cannot give a 2fi-opt design.")
  }

  sumT <- sum(t)
  if (sumT > n_total) {
    stop("Base columns already exceed allowable total multiplicities ",
         "(sum of minimal counts > n_total).")
  }

  remaining <- n_total - sumT
  while (remaining > 0) {
    idxs <- which(t < alpha + 1L)
    if (length(idxs) == 0) {
      stop("No room to allocate remaining columns without exceeding alpha+1.")
    }
    for (idx in idxs) {
      if (remaining == 0) break
      t[idx] <- t[idx] + 1L
      remaining <- remaining - 1L
    }
  }

  extra <- t - base_counts
  if (any(extra < 0)) stop("Internal error: negative extra multiplicity.")

  n_extra <- sum(extra)
  if (n_extra == 0) return(matrix(0, nrow = d, ncol = 0))

  X <- matrix(0, nrow = d, ncol = n_extra)
  col_idx <- 1L
  for (i in 1:L) {
    need_i <- extra[i]
    if (need_i > 0) {
      v <- pts[i, ]
      for (k in 1:need_i) {
        X[, col_idx] <- v
        col_idx <- col_idx + 1L
      }
    }
  }
  modp(X, s)
}

#' Construct a reverse-identity matrix
#'
#' @param p Integer matrix order.
#'
#' @return A \code{p} by \code{p} reverse-identity matrix.
#'
#' @keywords internal
H_matrix <- function(p) {
  H <- matrix(0, nrow = p, ncol = p)
  for (i in 1:p) H[i, p + 1 - i] <- 1
  H
}


#' Build a full-design generator matrix for odd prime levels
#'
#' Constructs the generator matrix used for full row-column factorial designs
#' when \code{s} is an odd prime and \code{n = p + q}.
#'
#' @param s Odd prime number of levels.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#'
#' @return Integer generator matrix with \code{p + q} rows and \code{p + q}
#'   columns.
#'
#' @keywords internal
build_G_full_oddprime <- function(s, p, q) {
  if (s == 2) stop("build_G_full_oddprime assumes odd prime s >= 3.")
  n <- p + q

  if (p == 1) {
    Iq <- diag(q)
    Jq <- matrix(1, q, q)
    Gc <- matrix(c(1, rep(1, q)), nrow = 1)
    Gr <- cbind(matrix(1, q, 1), modp(Iq + Jq, s))
    G  <- rbind(Gc, Gr)
    return(modp(G, s))
  }

  if (p == 2) {
    I2 <- diag(2)
    M  <- matrix(c(1, 2, 1, 1), nrow = 2, byrow = TRUE)
    base    <- cbind(I2, M)
    n_total <- n
    Xstar   <- extend_with_pg_points(base, d = 2, s = s, n_total = n_total)

    top    <- cbind(I2, M, Xstar)
    mid    <- cbind(I2, modp(M + I2, s),
                    matrix(0, nrow = 2, ncol = ncol(Xstar)))
    bottom <- cbind(matrix(0, nrow = q - 2, ncol = 4),
                    diag(q - 2))

    G <- rbind(top, mid, bottom)
    return(modp(G, s))
  }

  Ip <- diag(p)
  Jp <- matrix(1, p, p)
  Hp <- H_matrix(p)
  base    <- cbind(Ip, modp(Jp + Hp, s))
  n_total <- n
  Ystar   <- extend_with_pg_points(base, d = p, s = s, n_total = n_total)

  top    <- cbind(Ip, modp(Jp + Hp, s), Ystar)
  mid    <- cbind(Hp, modp(Jp + 2 * Ip, s),
                  matrix(0, nrow = p, ncol = ncol(Ystar)))
  bottom <- cbind(matrix(0, nrow = q - p, ncol = 2 * p),
                  diag(q - p))

  G <- rbind(top, mid, bottom)
  modp(G, s)
}


#' Build a one-replicate-fraction generator matrix for odd prime levels
#'
#' Constructs the generator matrix used for one-replicate fractional row-column
#' designs when \code{s} is an odd prime and \code{n = p + q + 1}.
#'
#' @param s Odd prime number of levels.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#'
#' @return Integer generator matrix with \code{p + q} rows and \code{p + q + 1}
#'   columns.
#'
#' @keywords internal
build_G_frac_oddprime <- function(s, p, q) {
  if (s == 2) stop("build_G_frac_oddprime assumes odd prime s >= 3.")
  n <- p + q + 1

  ## ---------- p = 1: keep your existing Theorem 9 case ----------
  if (p == 1) {
    # G = [ 1   1_q^T   2
    #       1_q I_q+J_q 1_q ]
    Iq <- diag(q)
    Jq <- matrix(1, q, q)
    Gc <- matrix(c(1, rep(1, q), 2), nrow = 1)  # 1 x (q+2)
    Gr <- cbind(matrix(1, q, 1),
                modp(Iq + Jq, s),
                matrix(1, q, 1))
    G <- rbind(Gc, Gr)
    return(modp(G, s))
  }


  Ip <- diag(p)
  Jp <- matrix(1, p, p)
  Hp <- H_matrix(p)

  ap <- rep(1, p)                     # a = 1_p
  e1 <- c(1, rep(0, p - 1))
  ep <- c(rep(0, p - 1), 1)
  bp <- modp(2 * ap + e1 - ep, s)     # b = 2a + e1 - ep

  # Base columns for PG(p-1,s): [Ip | Jp + Hp | a]
  base    <- cbind(Ip, modp(Jp + Hp, s), ap)
  n_total <- n                        # total columns required
  Xstar   <- extend_with_pg_points(base, d = p, s = s, n_total = n_total)

  # Each block will now have n = p + q + 1 columns:
  #   cols = p (Ip) + p (Jp+Hp) + 1 (a) + (#extra) = n
  top <- cbind(Ip, modp(Jp + Hp, s), ap, Xstar)
  mid <- cbind(Hp,
               modp(Jp + 2 * Ip, s),
               bp,
               matrix(0, nrow = p, ncol = ncol(Xstar)))

  if (q > p) {
    # bottom block has q - p rows, same n columns:
    # zeros for first (2p+1) columns, identity on the last (q-p)
    bottom <- cbind(
      matrix(0, nrow = q - p, ncol = 2 * p + 1),
      diag(q - p)
    )
    G <- rbind(top, mid, bottom)
  } else {
    # if q == p, no extra rows needed
    G <- rbind(top, mid)
  }

  modp(G, s)
}



#' Build a one-replicate-fraction generator matrix for two levels
#'
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#'
#' @return Integer generator matrix for the implemented two-level fractional
#'   construction.
#'
#' @keywords internal
build_G_frac_twolevel <- function(p, q) {
  s <- 2
  if (p == 1 && q >= 3) {
    Iq <- diag(q)
    Jq <- matrix(1, q, q)
    eq <- rep(0, q); eq[q] <- 1
    Gc <- matrix(c(1, rep(1, q), 1), nrow = 1)
    Gr <- cbind(matrix(1, q, 1),
                modp(Iq + Jq, s),
                eq)
    G <- rbind(Gc, Gr)
    return(modp(G, s))
  }
  stop("2-level fractional designs with p >= 2 are not yet implemented here.")
}


#' Build a generator matrix for theorem-based row-column designs
#'
#' Dispatches to the implemented theorem-based generator-matrix construction for
#' full designs and one-replicate fractions.
#'
#' @param s Integer. Number of levels. Prime values are supported by the
#'   theorem-based constructions.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#' @param n Integer. Number of treatment factors. Must be either \code{p + q}
#'   or \code{p + q + 1}.
#'
#' @return Integer generator matrix with \code{p + q} rows and \code{n} columns.
#'
#' @examples
#' G <- build_G(s = 3, p = 1, q = 1, n = 2)
#' G
#' stopifnot(nrow(G) == 2, ncol(G) == 2)
#'
#' @seealso \code{\link{generate_row_column_design}}
#' @export
build_G <- function(s, p, q, n) {
  if (n == p + q) {
    if (s == 2) {
      stop("Full 2-level 2fi-optimal designs not implemented in this script.")
    }
    return(build_G_full_oddprime(s, p, q))
  }
  if (n == p + q + 1) {
    if (s == 2) {
      return(build_G_frac_twolevel(p, q))
    } else {
      return(build_G_frac_oddprime(s, p, q))
    }
  }
  stop("build_G supports only n = p+q (full) or n = p+q+1 (one-replicate fraction).")
}


#' Generate the row-column treatment layout from a generator matrix
#'
#' Converts a generator matrix \code{G} into a row-column design by combining the
#' row-generator and column-generator parts over \code{GF(s)}.
#'
#' @param G Integer generator matrix with \code{p + q} rows.
#' @param s Integer. Number of levels.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#'
#' @return A list containing \code{s}, \code{p}, \code{q}, \code{n}, \code{G},
#'   \code{design}, \code{Gc}, and \code{Gr}. The \code{design} component is a
#'   data frame with columns \code{Row}, \code{Col}, and \code{F1}, ..., \code{Fn}.
#'
#' @examples
#' G <- build_G(s = 3, p = 1, q = 1, n = 2)
#' res <- generate_row_column_design(G, s = 3, p = 1, q = 1)
#' head(res$design)
#' stopifnot(all(c("Row", "Col", "F1", "F2") %in% names(res$design)))
#'
#' @export
generate_row_column_design <- function(G, s, p, q) {
  G <- modp(G, s)
  if (nrow(G) != p + q) stop("G must have p+q rows.")
  n <- ncol(G)

  Gc <- G[1:p, , drop = FALSE]
  Gr <- G[(p+1):(p+q), , drop = FALSE]

  row_coef <- as.matrix(expand.grid(rep(list(0:(s - 1)), p)))
  col_coef <- as.matrix(expand.grid(rep(list(0:(s - 1)), q)))
  sp <- nrow(row_coef); sq <- nrow(col_coef)

  X_rows <- matrix(0, nrow = sp, ncol = n)
  for (i in 1:sp) {
    a <- row_coef[i, ]
    X_rows[i, ] <- modp(as.numeric(a %*% Gc), s)
  }
  Y_cols <- matrix(0, nrow = sq, ncol = n)
  for (j in 1:sq) {
    b <- col_coef[j, ]
    Y_cols[j, ] <- modp(as.numeric(b %*% Gr), s)
  }

  design <- matrix(0, nrow = sp * sq, ncol = n + 2)
  colnames(design) <- c("Row", "Col", paste0("F", 1:n))
  idx <- 1L
  for (i in 1:sp) {
    for (j in 1:sq) {
      z <- modp(X_rows[i, ] + Y_cols[j, ], s)
      design[idx, ] <- c(i, j, z)
      idx <- idx + 1L
    }
  }
  design <- as.data.frame(design)
  for (k in 1:n) design[[2 + k]] <- as.integer(design[[2 + k]])

  list(
    s      = s,
    p      = p,
    q      = q,
    n      = n,
    G      = G,
    design = design,
    Gc     = Gc,
    Gr     = Gr
  )
}


#' Heuristic row-column layout for composite or unsupported cases
#'
#' Uses random starts and coordinate exchange to select a run subset and assign
#' treatments to a row-column array by minimizing a D-optimality aliasing
#' objective.
#'
#' @param s Integer. Number of levels.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#' @param n Integer. Number of treatment factors.
#' @param max_iter Integer. Maximum coordinate-exchange iterations per start.
#' @param n_starts Integer. Number of random starts.
#' @param verbose Logical. If \code{TRUE}, reports progress using \code{message()}.
#'   The default is \code{FALSE} so calls are quiet unless explicitly requested.
#' @param max_full Numeric. Maximum full-factorial candidate size allowed.
#'
#' @return A list containing the heuristic design, objective value, and metadata.
#'
#' @keywords internal
heuristic_rowcol_composite <- function(
    s, p, q, n,
    max_iter = 5000,
    n_starts = 5,
    verbose  = FALSE,
    max_full = 1e7
) {
  r <- p + q
  if (r > n) {
    stop("Need p + q <= n for heuristic_rowcol_composite.")
  }
  k <- n - r
  N_runs  <- s^r
  N_total <- s^n

  if (N_total > max_full) {
    stop("Full factorial size s^n = ", N_total,
         " exceeds max_full = ", max_full, ".")
  }
  if (N_total < N_runs) {
    stop("Full factorial s^n has only ", N_total, " points, but need ", N_runs)
  }

  # all full-factorial points in n factors
  lvl_list  <- replicate(n, 0:(s - 1), simplify = FALSE)
  treat_all <- as.matrix(expand.grid(lvl_list))

  n_row <- s^p
  n_col <- s^q
  if (n_row * n_col != N_runs) {
    stop("Dimension mismatch: s^p * s^q must equal s^(p+q).")
  }

  best_design <- NULL
  best_obj    <- Inf

  for (start in seq_len(n_starts)) {
    if (verbose) message("Heuristic start ", start, "/", n_starts)

    # subset of full factorial (if k>0) or permutation of all points (if k=0)
    idx_subset <- sample.int(N_total, size = N_runs, replace = FALSE)
    treat_sub  <- treat_all[idx_subset, , drop = FALSE]

    # initial assignment to row/column array
    design_mat <- cbind(
      Row = rep(1:n_row, each = n_col),
      Col = rep(1:n_col, times = n_row),
      treat_sub
    )

    obj <- alias_objective_Dopt(design_mat, s)
    iter     <- 0L
    improved <- TRUE

    # simple coordinate-exchange on treatment positions
    while (improved && iter < max_iter) {
      iter <- iter + 1L
      improved <- FALSE
      i <- sample.int(N_runs, 1L)
      j <- sample.int(N_runs, 1L)
      if (i == j) next

      new_design <- design_mat
      tmp <- new_design[i, 3:(n + 2)]
      new_design[i, 3:(n + 2)] <- new_design[j, 3:(n + 2)]
      new_design[j, 3:(n + 2)] <- tmp

      new_obj <- alias_objective_Dopt(new_design, s)
      if (new_obj + 1e-8 < obj) {
        design_mat <- new_design
        obj        <- new_obj
        improved   <- TRUE
      }
    }

    if (verbose) {
      message("  D-objective at end of start ", start, ": ", signif(obj, 5))
    }
    if (obj < best_obj) {
      best_obj    <- obj
      best_design <- design_mat
    }
  }

  best_df <- as.data.frame(best_design)
  colnames(best_df) <- c("Row", "Col", paste0("F", 1:n))

  list(
    s               = s,
    p               = p,
    q               = q,
    n               = n,
    k               = k,
    G               = NULL,
    design          = best_df,
    heuristic       = TRUE,
    D_opt_objective = best_obj
  )
}



#' Evaluate unconfounded main effects and two-factor interactions
#'
#' Checks whether treatment main effects are unconfounded with the remaining
#' model terms and counts the number of unconfounded two-factor interactions in
#' a row-column factorial design.
#'
#' @param design_df Data frame with columns \code{Row}, \code{Col}, and treatment
#'   factor columns.
#' @param s Integer. Number of levels per treatment factor.
#' @param tol Numeric tolerance for declaring cross-products to be zero.
#'
#' @return A list with components \code{main_ok}, a logical flag indicating
#'   whether all main effects are unconfounded, and \code{unconf_2fi_num}, the
#'   number of unconfounded two-factor interactions.
#'
#' @examples
#' res <- generate_2fi_rowcol(s = 3, p = 1, q = 1, n = 2)
#' ev <- eval_2fi_from_design(res$design, s = 3)
#' ev
#' stopifnot(is.logical(ev$main_ok), length(ev$main_ok) == 1)
#'
#' @importFrom stats as.formula model.matrix terms
#' @export
eval_2fi_from_design <- function(design_df, s, tol = 1e-8) {
  if (!all(c("Row", "Col") %in% names(design_df))) {
    stop("design_df must have columns named 'Row' and 'Col'.")
  }
  all_cols  <- names(design_df)
  fact_cols <- all_cols[!(all_cols %in% c("Row", "Col"))]
  n <- length(fact_cols)
  if (n == 0) stop("No treatment factors.")

  df <- data.frame(
    row = factor(design_df$Row),
    col = factor(design_df$Col)
  )
  for (j in seq_len(n)) {
    df[[paste0("F", j)]] <-
      factor(design_df[[fact_cols[j]]], levels = 0:(s - 1))
  }

  old_contr <- options(contrasts = c("contr.sum", "contr.poly"))
  on.exit(options(old_contr), add = TRUE)

  form <- as.formula(
    paste0("~ row + col + (", paste(paste0("F", 1:n), collapse = " + "), ")^2")
  )
  mm <- model.matrix(form, data = df)
  X  <- mm[, -1, drop = FALSE]
  assign_vec  <- attr(mm, "assign")[-1]
  tt          <- terms(form, data = df)
  term_labels <- attr(tt, "term.labels")

  term_to_cols <- lapply(seq_along(term_labels), function(idx) {
    which(assign_vec == idx)
  })
  names(term_to_cols) <- term_labels

  is_group_unconfounded <- function(cols_idx) {
    if (length(cols_idx) == 0) return(FALSE)
    rest <- setdiff(seq_len(ncol(X)), cols_idx)
    if (length(rest) == 0) return(TRUE)
    cross <- crossprod(X[, cols_idx, drop = FALSE],
                       X[, rest, drop = FALSE])
    max(abs(cross)) < tol
  }

  main_ok <- TRUE
  for (j in seq_len(n)) {
    term_name <- paste0("F", j)
    if (!term_name %in% names(term_to_cols)) {
      main_ok <- FALSE; break
    }
    if (!is_group_unconfounded(term_to_cols[[term_name]])) {
      main_ok <- FALSE; break
    }
  }

  unconf_2fi <- 0L
  for (i in 1:(n - 1)) {
    for (j in (i + 1):n) {
      term_name1 <- paste0("F", i, ":", "F", j)
      term_name2 <- paste0("F", j, ":", "F", i)
      idx <- NULL
      if (term_name1 %in% names(term_to_cols)) {
        idx <- term_to_cols[[term_name1]]
      } else if (term_name2 %in% names(term_to_cols)) {
        idx <- term_to_cols[[term_name2]]
      }
      if (!is.null(idx)) {
        if (is_group_unconfounded(idx)) {
          unconf_2fi <- unconf_2fi + 1L
        }
      }
    }
  }

  list(
    main_ok        = main_ok,
    unconf_2fi_num = unconf_2fi
  )
}


#' Search for prime-level generator matrices for k = 2 or k = 3
#'
#' Performs a random search over generator matrices for prime-level designs when
#' \code{k = n - (p + q)} is 2 or 3, retaining the design with the largest number
#' of unconfounded two-factor interactions among candidates with unconfounded
#' main effects.
#'
#' @param s Prime integer number of levels. The search is tuned for \code{s <= 7}.
#' @param p Integer. Number of row blocking factors.
#' @param q Integer. Number of column blocking factors.
#' @param n Integer. Number of treatment factors.
#' @param max_tries Integer. Maximum number of random generator matrices to try.
#' @param N_max_runs Integer. Maximum allowed number of runs \code{s^(p + q)}.
#' @param verbose Logical. If \code{TRUE}, reports improvements during search
#'   using \code{message()}. The default is \code{FALSE}.
#'
#' @return A list containing the best generator matrix, design, number of
#'   unconfounded two-factor interactions, and search metadata.
#'
#' @examples
#' # The search is random, so a deliberately small number of tries may or may
#' # not find a feasible design on every platform. The example is therefore
#' # written to be executable and checkable without requiring stochastic success.
#' set.seed(1)
#' res <- try(
#'   search_2fi_optimal_G_k23(
#'     s = 5, p = 1, q = 1, n = 4,
#'     max_tries = 25, N_max_runs = 25, verbose = FALSE
#'   ),
#'   silent = TRUE
#' )
#' stopifnot(is.list(res) || inherits(res, "try-error"))
#'
#' @export
search_2fi_optimal_G_k23 <- function(s, p, q, n,
                                     max_tries   = 5000,
                                     N_max_runs  = 10000,
                                     verbose     = FALSE) {
  if (!is_prime(s)) stop("s must be prime for this search.")
  if (s > 7) stop("Function tuned for s <= 7.")
  if (n > 9) stop("Function tuned for n <= 9.")
  r <- p + q
  if (r > n) stop("Need p + q <= n.")
  k <- n - r
  if (!(k %in% c(2, 3))) stop("Intended for k=2 or 3; here k=", k)

  N_runs <- s^r
  if (N_runs > N_max_runs) {
    stop("s^(p+q) = ", N_runs, " > N_max_runs = ", N_max_runs)
  }

  best_G      <- NULL
  best_design <- NULL
  best_unconf <- -Inf

  for (attempt in 1:max_tries) {
    G <- matrix(0, nrow = r, ncol = n)
    for (j in 1:n) {
      repeat {
        col <- sample(0:(s - 1), size = r, replace = TRUE)
        if (!all(col == 0)) break
      }
      G[, j] <- col
    }
    G <- modp(G, s)

    # rank over GF(s)
    rank_modp <- function(M, s) {
      M <- modp(M, s)
      nr <- nrow(M); nc <- ncol(M)
      r <- 0; row <- 1
      for (col in 1:nc) {
        pivot <- NA
        for (i in row:nr) {
          if (M[i, col] != 0) { pivot <- i; break }
        }
        if (is.na(pivot)) next
        if (pivot != row) {
          tmp <- M[row, ]; M[row, ] <- M[pivot, ]; M[pivot, ] <- tmp
        }
        inv <- inv_mod_scalar(M[row, col], s)
        M[row, ] <- modp(M[row, ] * inv, s)
        for (i in (row + 1):nr) {
          if (i > nr) break
          if (M[i, col] != 0) {
            factor <- M[i, col]
            M[i, ] <- modp(M[i, ] - factor * M[row, ], s)
          }
        }
        r   <- r + 1
        row <- row + 1
        if (row > nr) break
      }
      r
    }

    if (rank_modp(G, s) < r) next

    Gc <- G[1:p, , drop = FALSE]
    Gr <- G[(p+1):(p+q), , drop = FALSE]
    if (any(colSums(Gc != 0) == 0)) next
    if (any(colSums(Gr != 0) == 0)) next

    design_list <- generate_row_column_design(G, s, p, q)
    design_df   <- design_list$design

    eval <- eval_2fi_from_design(design_df, s)
    if (!eval$main_ok) next
    unconf_2fi <- eval$unconf_2fi_num

    if (unconf_2fi > best_unconf) {
      best_unconf <- unconf_2fi
      best_G      <- G
      best_design <- design_df
      if (verbose) {
        message("New best at attempt ", attempt,
                ": ", unconf_2fi, " unconfounded 2FIs.")
      }
    }
  }

  if (is.null(best_G)) {
    stop("No design with unconfounded main effects found in ", max_tries, " tries.")
  }

  list(
    s               = s,
    p               = p,
    q               = q,
    n               = n,
    k               = n - (p + q),
    G               = best_G,
    design          = best_design,
    unconf_2fi_best = best_unconf,
    heuristic       = FALSE,
    search_based    = TRUE,
    max_tries       = max_tries
  )
}
