# ============================================================
# Internal utilities: motif spec initialisation, input
# validation, and parallel backend management.
# ============================================================


# ------------------------------------------------------------
# Motif specification
# ------------------------------------------------------------

#' Initialise and validate a list of motif specifications
#'
#' Parses a mixed list of built-in motif names (character strings) and
#' user-supplied specifications (lists with \code{fn} and \code{n_edges})
#' into an internal representation used throughout the package.
#'
#' Built-in motifs and their edge counts:
#' \itemize{
#'   \item \code{"v_shape"} -- 2-star (V-shape), 2 edges
#'   \item \code{"triangle"} -- triangle, 3 edges
#'   \item \code{"star3"} -- 3-star, 3 edges
#' }
#'
#' A user-supplied specification must be a named list with:
#' \itemize{
#'   \item \code{fn}: a \code{function(A)} that accepts a square binary
#'     adjacency matrix and returns a \emph{named} numeric vector of one or
#'     more moment values (one element per motif computed by that function).
#'   \item \code{n_edges}: integer vector whose length equals the length of
#'     \code{fn}'s return value, giving the number of edges in each
#'     corresponding motif.  Used for density normalisation.
#' }
#'
#' @param motifs A list of motif specifications (see above).
#'
#' @return A list with three elements:
#' \describe{
#'   \item{\code{compute}}{A function \code{function(A)} that evaluates all
#'     motifs on an adjacency matrix and returns a named numeric vector.}
#'   \item{\code{edge_counts}}{Integer vector of edge counts, one per moment.}
#'   \item{\code{names}}{Character vector of moment names, in the same order
#'     as \code{edge_counts}.}
#' }
#'
#' @importFrom stats setNames
#' @keywords internal
init_motif_specs <- function(motifs) {

  builtin_edge_counts <- c(v_shape = 2L, triangle = 3L, star3 = 3L)

  all_names       <- character(0)
  all_edge_counts <- integer(0)
  fn_list         <- list()

  # Small connected graph used to probe user-supplied functions.
  dummy_A <- matrix(
    c(0L, 1L, 1L, 0L, 0L,
      1L, 0L, 1L, 1L, 0L,
      1L, 1L, 0L, 0L, 1L,
      0L, 1L, 0L, 0L, 1L,
      0L, 0L, 1L, 1L, 0L),
    nrow = 5L, ncol = 5L
  )

  for (spec in motifs) {

    if (is.character(spec)) {
      # --- built-in motif ---
      if (!spec %in% names(builtin_edge_counts)) {
        stop(sprintf(
          "Unknown built-in motif '%s'. Valid names: %s",
          spec, paste(names(builtin_edge_counts), collapse = ", ")
        ))
      }
      all_names       <- c(all_names,       spec)
      all_edge_counts <- c(all_edge_counts, builtin_edge_counts[[spec]])
      fn_list         <- c(fn_list, list(list(type = "builtin", name = spec)))

    } else if (is.list(spec) && !is.null(spec$fn) && !is.null(spec$n_edges)) {
      # --- user-supplied spec ---
      if (!is.function(spec$fn)) {
        stop("'fn' in a user-supplied motif specification must be a function.")
      }

      # Call fn on dummy matrix to discover output names and validate length.
      test_out <- tryCatch(
        spec$fn(dummy_A),
        error = function(e) stop(
          "User-supplied motif function failed on a 5x5 test matrix: ",
          conditionMessage(e)
        )
      )
      if (!is.numeric(test_out)) {
        stop("User-supplied motif function must return a numeric vector.")
      }
      n_out    <- length(test_out)
      n_edges  <- as.integer(spec$n_edges)
      if (length(n_edges) != n_out) {
        stop(sprintf(
          "Length of 'n_edges' (%d) must match the output length of 'fn' (%d).",
          length(n_edges), n_out
        ))
      }

      # Assign names: use names from fn output, or generate defaults.
      custom_names <- if (!is.null(names(test_out))) {
        names(test_out)
      } else {
        paste0("custom_", seq_len(n_out))
      }

      all_names       <- c(all_names,       custom_names)
      all_edge_counts <- c(all_edge_counts, n_edges)
      fn_list         <- c(fn_list, list(list(type = "custom", fn = spec$fn)))

    } else {
      stop(
        "Each motif specification must be a character string or a list with ",
        "elements 'fn' (a function) and 'n_edges' (an integer vector)."
      )
    }
  }

  if (length(all_names) == 0L) {
    stop("'motifs' must contain at least one motif specification.")
  }

  # Determine once whether A^2 is needed (shared by v_shape and triangle).
  builtin_names <- vapply(
    fn_list,
    function(x) if (x$type == "builtin") x$name else "",
    character(1L)
  )
  needs_A2 <- any(builtin_names %in% c("v_shape", "triangle"))

  # Build the combined compute function.  All captured objects are frozen in
  # a local environment so the closure remains self-contained.
  compute_fn <- local({
    fns     <- fn_list
    use_A2  <- needs_A2
    nms     <- all_names

    function(A) {
      k      <- nrow(A)
      result <- numeric(0L)
      A2     <- if (use_A2) A %*% A else NULL

      for (spec in fns) {
        if (spec$type == "builtin") {
          val <- switch(
            spec$name,
            v_shape = {
              if (k < 3L) {
                0
              } else {
                count_v <- sum(A2) - sum(diag(A2))
                count_v / (k * (k - 1L) * (k - 2L) / 3L)
              }
            },
            triangle = {
              if (k < 3L) {
                0
              } else {
                sum(A * A2) / (k * (k - 1L) * (k - 2L))
              }
            },
            star3 = {
              if (k < 4L) {
                0
              } else {
                vv <- colSums(A)
                sum(choose(vv, 3L)) /
                  (k * (k - 1L) * (k - 2L) * (k - 3L) / 24L)
              }
            }
          )
          result <- c(result, stats::setNames(val, spec$name))
        } else {
          result <- c(result, spec$fn(A))
        }
      }
      result
    }
  })

  list(
    compute     = compute_fn,
    edge_counts = all_edge_counts,
    names       = all_names
  )
}


# ------------------------------------------------------------
# Input validation
# ------------------------------------------------------------

#' Validate an adjacency matrix
#'
#' Checks that \code{A} is a square matrix (dense or sparse \code{Matrix})
#' and warns if it does not appear symmetric.
#'
#' @param A Object to validate.
#' @param name Name used in error messages.
#'
#' @keywords internal
validate_adjacency <- function(A, name = "A") {
  if (!is.matrix(A) && !inherits(A, "Matrix")) {
    stop(sprintf("'%s' must be a matrix or sparse Matrix object.", name))
  }
  if (nrow(A) != ncol(A)) {
    stop(sprintf(
      "'%s' must be square (got %d x %d).",
      name, nrow(A), ncol(A)
    ))
  }
  if (is.matrix(A) && max(abs(A - t(A))) > 1e-10) {
    warning(sprintf(
      "'%s' does not appear to be symmetric; results may be unreliable.", name
    ))
  }
}


# ------------------------------------------------------------
# Parallel backend management
# ------------------------------------------------------------

#' Set up a foreach parallel backend
#'
#' Registers a \pkg{doParallel} backend when requested and returns the
#' appropriate foreach binary operator together with a cleanup function.
#'
#' @param parallel Logical; whether parallelism is requested.
#' @param n_cores  Integer or \code{NULL}.  When \code{parallel = TRUE} and
#'   \code{n_cores} is \code{NULL}, one fewer than the number of detected
#'   cores is used (minimum 1).
#'
#' @return A list with:
#' \describe{
#'   \item{\code{op}}{The foreach binary operator (\code{\%do\%} or
#'     \code{\%dopar\%}).}
#'   \item{\code{cleanup}}{A zero-argument function that stops any cluster
#'     created here and re-registers the sequential backend.}
#' }
#'
#' @importFrom doParallel registerDoParallel
#' @importFrom foreach registerDoSEQ
#' @importFrom parallel detectCores makeCluster stopCluster
#' @keywords internal
setup_foreach <- function(parallel, n_cores) {

  if (!parallel) {
    return(list(
      op      = foreach::`%do%`,
      cleanup = function() invisible(NULL)
    ))
  }

  cores <- if (!is.null(n_cores)) {
    max(1L, as.integer(n_cores))
  } else {
    max(1L, parallel::detectCores() - 1L)
  }

  cl <- parallel::makeCluster(cores)
  doParallel::registerDoParallel(cl)

  list(
    op      = foreach::`%dopar%`,
    cleanup = function() {
      parallel::stopCluster(cl)
      foreach::registerDoSEQ()
    }
  )
}
