#' @title
#' Develop Concise but Comprehensive Shortened Versions of Psychometric Instruments
#'
#' @description
#' Operationalizes the identification problem of which subset of items should be kept in the shortened version of a said psychometric instrument to best represent the set of items comprised in the original version of the said psychometric instrument.
#'
#' @param n.mat
#' The symmetric matrix of associations (e.g., of zero-order polychoric correlation coefficients) computed from the set of items comprised in the original version of the said psychometric instrument. Must be a symmetric matrix of numeric.
#'
#' @param k
#' The number of items in the subset of items to be comprised in the shortened version of the said psychometric instrument. Must be a non-null positive integer.
#'
#' @param algorithm
#' The combinatorial search algorithm. Must match either `"brute.force"` or `"simulated.annealing"`. Default is `"brute.force"`.
#'
#' @param start.temp
#' The starting temperature in the simulated annealing search. Must be a non-null positive numeric lying within the interval (0, 1], and must be greater than stop.temp, the stopping temperature. Default is `1`.
#'
#' @param cool.fact
#' The cooling factor in the simulated annealing search. Must be a non-null positive numeric lying within the interval (0, 1). Default is `0.999`.
#'
#' @param stop.temp
#' The stopping temperature in the simulated annealing search. Must be a non-null positive numeric lying within the interval (0, 1), and must be less than start.temp, the starting temperature. Default is `0.001`.
#'
#' @param n.runs
#' The number of runs in the simulated annealing search. Must be a non-null positive integer. Default is `1000`.
#'
#' @param seed
#' The random number generator state for random number generation in the simulated annealing search. Must be a non-null positive integer or must match `NULL`. Default is `5107`.
#'
#' @param verbose
#' Whether information messages should be printed to the console. Must match either `FALSE` or `TRUE`. Default is `TRUE`.
#'
#' @return
#' A list of two named objects pertaining to the solution to the identification problem yielded by the combinatorial search algorithm:
#' \describe{
#'  \item{\strong{solution.character}}{A character denoting the subset of items to be comprised in the shortened version of the said psychometric instrument.}
#'  \item{\strong{solution.numeric}}{A numeric denoting the sum of the absolute values of the associations between the subset of items to be comprised in the shortened version of the said psychometric instrument and the subset of items not to be comprised in the shortened version of the said psychometric instrument.}
#' }
#'
#' @details
#' Let \eqn{N} denote the indices corresponding to the set of items comprised in the original version of a said psychometric instrument, and let \eqn{n = |N|} denote its cardinality, with \eqn{n \in \mathbb{N}}. Let \eqn{i, j \in N} denote arbitrary indices. Let \eqn{K \subset N} denote the indices corresponding to the subset of items to be comprised in the shortened version of the said psychometric instrument, and let \eqn{k = |K|} denote its cardinality, with \eqn{k \in \{1, \ldots, n-1\}}. Let \eqn{A = (a_{ij}) \in \mathbb{R}^{n \times n}} denote a symmetric matrix of associations (e.g., of zero-order polychoric correlation coefficients) computed from the set of items comprised in the original version of the said psychometric instrument, satisfying \eqn{A = A^\top \Leftrightarrow a_{ij} = a_{ji}} for all \eqn{i, j \in N}. Each element \eqn{a_{ij}} represents an association (e.g., a zero-order polychoric correlation coefficient) between the items indexed by \eqn{i} and \eqn{j}. Let \eqn{K^c = N \setminus K} denote the complement of \eqn{K} in \eqn{N}, with \eqn{|K^c| = n - k}. The objective is to identify the subset of indices \eqn{K \subset N} of cardinality \eqn{|K| = k} that maximizes the sum of the absolute values of the associations \eqn{a_{ij}} for all \eqn{i \in K} and \eqn{j \in K^c}. Formally, such an identification problem is expressed as follows:\cr\cr
#' \deqn{\max_{K \subset N, |K| = k} \sum_{i \in K} \sum_{j \in K^c} |a_{ij}|}
#'
#' @examples
#' n.mat <- (
#'   stats::runif(n = 25^2, min = -1, max = 1) |>
#'   base::matrix(nrow = 25, ncol = 25) |>
#'   (\(m) (m + base::t(m)) / 2)() |>
#'   (\(m) {base::diag(m) <- 0; m})()
#' )
#'
#' shortr::shortr(
#'   n.mat = n.mat,
#'   k = 5,
#'   algorithm = "brute.force"
#' )
#'
#' @references
#' Fournier, L., Heeren, A., Baggio, S., Clark, L., Verdejo-García, A., Perales, J. C., & Billieux, J. (2026). *shortr: Develop concise but comprehensive shortened versions of psychometric instruments* (*R* package version 1.0.3) \[Computer software\]. \doi{10.32614/CRAN.package.shortr}
#'
#' @encoding
#' UTF-8
#'
#' @importFrom
#' stats
#' runif
#'
#' @importFrom
#' utils
#' setTxtProgressBar
#' txtProgressBar
#'
#' @export
shortr <- function(n.mat, k, algorithm = base::c("brute.force", "simulated.annealing"), start.temp = 1, cool.fact = 0.999, stop.temp = 0.001, n.runs = 1000, seed = 5107, verbose = TRUE) {
  
  ##### n.mat, the symmetric matrix of associations, must be a numeric matrix of numeric
  
  if (!base::is.matrix(n.mat) || !base::is.numeric(n.mat) || base::nrow(n.mat) < 2 || base::nrow(n.mat) != base::ncol(n.mat)) {
    
    base::stop("n.mat, the symmetric matrix of associations, must be a symmetric matrix of numeric\n", call. = FALSE)
    
  }
  
  nan.mask <- base::is.nan(n.mat)
  
  if (base::any(nan.mask)) {
    
    n.mat[nan.mask] <- NA
    
  }
  
  na.mask <- base::is.na(n.mat)
  
  if (base::any(na.mask)) {
    
    n.na <- base::sum(na.mask)
    
    if (n.na == 1) {
      
      base::warning(n.na, " NA/NaN value in n.mat was replaced with a null value\n", call. = FALSE)
      
    }
    
    if (n.na > 1) {
      
      base::warning(n.na, " NA/NaN values in n.mat were replaced with null values\n", call. = FALSE)
      
    }
    
    n.mat[na.mask] <- 0
    
  }
  
  if (!base::isSymmetric(base::unname(n.mat)) || base::any(base::is.infinite(n.mat))) {
    
    base::stop("n.mat, the symmetric matrix of associations, must be a symmetric matrix of numeric\n", call. = FALSE)
    
  }
  
  ##### k, the number of items in the subset, must be a non-null positive integer
  
  if (!base::is.numeric(k) || base::length(k) != 1 || base::is.na(k) || k != base::as.integer(k) || k < 1L) {
    
    base::stop("k, the number of items in the subset, must be a non-null positive integer\n", call. = FALSE)
    
  }
  
  k <- base::as.integer(k)
  
  ##### k, the number of items in the subset, must be strictly less than n, the number of items in the set
  
  if (k >= base::nrow(n.mat)) {
    
    base::stop("k, the number of items in the subset, must be strictly less than n, the number of items in the set\n", call. = FALSE)
    
  }
  
  ##### algorithm, the combinatorial search algorithm, must match either "brute.force" or "simulated.annealing"
  
  algorithm <- base::match.arg(algorithm)
  
  ##### if algorithm, the combinatorial search algorithm, matches "simulated.annealing"
  
  if (algorithm == "simulated.annealing") {
    
    ##### start.temp, the starting temperature, must be a non-null positive numeric lying within the interval (0, 1]
    
    if (!base::is.numeric(start.temp) || base::length(start.temp) != 1 || base::is.na(start.temp) || start.temp <= 0 || start.temp > 1) {
      
      base::stop("start.temp, the starting temperature, must be a non-null positive numeric lying within the interval (0, 1]\n", call. = FALSE)
      
    }
    
    ##### cool.fact, the cooling factor, must be a non-null positive numeric lying within the interval (0, 1)
    
    if (!base::is.numeric(cool.fact) || base::length(cool.fact) != 1 || base::is.na(cool.fact) || cool.fact <= 0 || cool.fact >= 1) {
      
      base::stop("cool.fact, the cooling factor, must be a non-null positive numeric lying within the interval (0, 1)\n", call. = FALSE)
      
    }
    
    ##### stop.temp, the stopping temperature, must be a non-null positive numeric lying within the interval (0, 1)
    
    if (!base::is.numeric(stop.temp) || base::length(stop.temp) != 1 || base::is.na(stop.temp) || stop.temp <= 0 || stop.temp >= 1) {
      
      base::stop("stop.temp, the stopping temperature, must be a non-null positive numeric lying within the interval (0, 1)\n", call. = FALSE)
      
    }
    
    ##### start.temp, the starting temperature, must be greater than stop.temp, the stopping temperature
    
    if (start.temp <= stop.temp) {
      
      base::stop("start.temp, the starting temperature, must be greater than stop.temp, the stopping temperature\n", call. = FALSE)
      
    }
    
    ##### n.runs, the number of runs in the simulated annealing search, must be a non-null positive integer
    
    if (!base::is.numeric(n.runs) || base::length(n.runs) != 1 || base::is.na(n.runs) || n.runs < 1 || n.runs != base::as.integer(n.runs)) {
      
      base::stop("n.runs, the number of runs in the simulated annealing search, must be a non-null positive integer\n", call. = FALSE)
      
    }
    
    n.runs <- base::as.integer(n.runs)
    
    ##### seed, the random number generator state for random number generation in the simulated annealing search, must be a non-null positive integer or must match NULL
    
    if (!base::is.null(seed)) {
      
      if (!base::is.numeric(seed) || base::length(seed) != 1 || base::is.na(seed) || seed < 1 || seed != base::as.integer(seed)) {
        
        base::stop("seed, the random number generator state for random number generation in the simulated annealing search, must be a non-null positive integer or must match NULL\n", call. = FALSE)
        
      }
      
      seed <- base::as.integer(seed)
      
      if (base::exists(".Random.seed", envir = base::globalenv())) {
        
        old.seed <- base::get(".Random.seed", envir = base::globalenv())
        
        base::on.exit(base::assign(".Random.seed", old.seed, envir = base::globalenv()), add = TRUE)
        
      } else {
        
        base::on.exit(base::rm(".Random.seed", envir = base::globalenv()), add = TRUE)
        
      }
      
      base::set.seed(seed)
      
    }
    
  }
  
  ##### verbose, whether information messages should be printed to the console, must match either FALSE or TRUE
  
  if (!base::is.logical(verbose) || base::length(verbose) != 1 || base::is.na(verbose)) {
    
    base::stop("verbose, whether information messages should be printed to the console, must match either FALSE or TRUE\n", call. = FALSE)
    
  }
  
  ##### brute force search or simulated annealing search
  
  n <- base::nrow(n.mat)
  
  N <- base::seq_len(n)
  
  base::diag(n.mat) <- 0
  
  if (base::is.null(base::colnames(n.mat))) {
    
    base::colnames(n.mat) <- N
    
  }
  
  colnames.n.mat <- base::colnames(n.mat)
  
  abs.n.mat <- base::abs(n.mat)
  
  row.sums.abs <- base::rowSums(abs.n.mat)
  
  n.choose.k <- base::choose(n, k)
  
  n.choose.k.format <- base::format(n.choose.k, big.mark = ",", scientific = FALSE)
  
  ##### brute force search
  
  if (algorithm == "brute.force") {
    
    if (!base::is.finite(n.choose.k) || n.choose.k > base::.Machine$integer.max) {
      
      base::message("Brute force combinatorial search is computationally intractable: ", n.choose.k.format, " candidate subsets cannot be examined. We recommend opting for simulated annealing combinatorial search.")
      
      base::return(base::invisible(NULL))
      
    }
    
    use.complement <- k > n %/% 2L
    
    effective.k <- if (use.complement) n - k else k
    
    update.interval <- base::max(1L, base::floor(n.choose.k / 1000L))
    
    if (verbose) {
      
      base::cat(base::paste0("\nExamining all ", n.choose.k.format, " candidate subsets...\n\n"))
      
      progress.bar <- utils::txtProgressBar(min = 0, max = n.choose.k, style = 3)
      
      base::on.exit(base::close(progress.bar), add = TRUE)
      
    }
    
    K <- base::seq_len(effective.k)
    
    sum.row.K <- base::sum(row.sums.abs[K])
    
    sum.internal.K <- base::sum(abs.n.mat[K, K])
    
    f.K.current <- sum.row.K - sum.internal.K
    
    f.K.star <- f.K.current
    
    K.star <- K
    
    iter <- 1L
    
    repeat {
      
      if (verbose && (iter %% update.interval == 0L)) {
        
        utils::setTxtProgressBar(progress.bar, iter)
        
      }
      
      i <- effective.k
      
      while (i > 0L && K[i] == n - effective.k + i) {
        
        i <- i - 1L
        
      }
      
      if (i == 0L) break
      
      old.idx <- K[i:effective.k]
      
      K[i] <- K[i] + 1L
      
      if (i < effective.k) {
        
        j <- i + 1L
        
        while (j <= effective.k) {
          
          K[j] <- K[j - 1L] + 1L
          
          j <- j + 1L
          
        }
        
      }
      
      new.idx <- K[i:effective.k]
      
      delta.row <- base::sum(row.sums.abs[new.idx]) - base::sum(row.sums.abs[old.idx])
      
      sum.row.K <- sum.row.K + delta.row
      
      if (i > 1L) {
        
        unch.idx <- K[1L:(i - 1L)]
        
        new.uc <- base::sum(abs.n.mat[new.idx, unch.idx, drop = FALSE])
        
        old.uc <- base::sum(abs.n.mat[old.idx, unch.idx, drop = FALSE])
        
      } else {
        
        new.uc <- 0
        
        old.uc <- 0
        
      }
      
      n.changed <- base::length(new.idx)
      
      if (n.changed > 1L) {
        
        new.cc <- base::sum(abs.n.mat[new.idx, new.idx, drop = FALSE])
        
        old.cc <- base::sum(abs.n.mat[old.idx, old.idx, drop = FALSE])
        
      } else {
        
        new.cc <- 0
        
        old.cc <- 0
        
      }
      
      delta.internal <- 2 * (new.uc - old.uc) + (new.cc - old.cc)
      
      sum.internal.K <- sum.internal.K + delta.internal
      
      f.K.current <- sum.row.K - sum.internal.K
      
      iter <- iter + 1L
      
      if (f.K.current > f.K.star) {
        
        f.K.star <- f.K.current
        
        K.star <- K
        
      }
      
    }
    
    if (use.complement) {
      
      K.star <- base::setdiff(N, K.star)
      
    }
    
    K.star <- base::sort(K.star)
    
    if (verbose) {
      
      utils::setTxtProgressBar(progress.bar, n.choose.k)
      
      base::cat("\n\nNumber of candidate subsets examined:", n.choose.k.format, "\n")
      
      base::cat("\nSolution identified!\n")
      
      base::cat("\nSolution (character):", base::paste(colnames.n.mat[K.star], collapse = " -- "), "\n")
      
      base::cat("\nSolution (numeric):", base::format(base::round(f.K.star, 3), big.mark = ",", nsmall = 3), "\n\n")
      
    }
    
    base::return(base::invisible(base::list(solution.character = colnames.n.mat[K.star], solution.numeric = f.K.star)))
    
  }
  
  ##### simulated annealing search
  
  if (algorithm == "simulated.annealing") {
    
    f.K.star <- -Inf
    
    K.star <- NULL
    
    iter <- 0L
    
    I <- base::ceiling(base::log(stop.temp / start.temp) / base::log(cool.fact))
    
    IR <- base::as.double(n.runs) * I
    
    update.interval <- base::max(1L, base::floor(IR / 1000L))
    
    if (verbose) {
      
      base::cat(base::paste0("\nExamining part of all ", n.choose.k.format, " candidate subsets...\n\n"))
      
      progress.bar <- utils::txtProgressBar(min = 0, max = IR, style = 3)
      
      base::on.exit(base::close(progress.bar), add = TRUE)
      
    }
    
    for (run.i in base::seq_len(n.runs)) {
      
      K <- base::sample.int(n, k)
      
      K.c <- base::setdiff(N, K)
      
      sum.row.K <- base::sum(row.sums.abs[K])
      
      sum.internal.K <- base::sum(abs.n.mat[K, K])
      
      f.K.current <- sum.row.K - sum.internal.K
      
      K.star.i <- K
      
      f.K.star.i <- f.K.current
      
      temp <- start.temp
      
      for (i in base::seq_len(I)) {
        
        swap.out <- base::sample.int(k, 1L)
        
        swap.in.pos <- base::sample.int(n - k, 1L)
        
        swap.in <- K.c[swap.in.pos]
        
        idx.out <- K[swap.out]
        
        unch.idx <- K[-swap.out]
        
        delta.row <- row.sums.abs[swap.in] - row.sums.abs[idx.out]
        
        new.uc <- base::sum(abs.n.mat[swap.in, unch.idx])
        
        old.uc <- base::sum(abs.n.mat[idx.out, unch.idx])
        
        delta.internal <- 2 * (new.uc - old.uc)
        
        f.K.candidate <- f.K.current + delta.row - delta.internal
        
        iter <- iter + 1L
        
        if (f.K.candidate > f.K.current || stats::runif(1) < base::exp((f.K.candidate - f.K.current) / temp)) {
          
          K[swap.out] <- swap.in
          
          K.c[swap.in.pos] <- idx.out
          
          sum.row.K <- sum.row.K + delta.row
          
          sum.internal.K <- sum.internal.K + delta.internal
          
          f.K.current <- f.K.candidate
          
          if (f.K.candidate > f.K.star.i) {
            
            f.K.star.i <- f.K.candidate
            
            K.star.i <- K
            
          }
          
        }
        
        temp <- temp * cool.fact
        
        if (verbose && (iter %% update.interval == 0L)) {
          
          utils::setTxtProgressBar(progress.bar, iter)
          
        }
        
      }
      
      if (f.K.star.i > f.K.star) {
        
        f.K.star <- f.K.star.i
        
        K.star <- K.star.i
        
      }
      
    }
    
    K.star <- base::sort(K.star)
    
    if (verbose) {
      
      utils::setTxtProgressBar(progress.bar, IR)
      
      iter.format <- base::format(iter, big.mark = ",", scientific = FALSE)
      
      base::cat("\n\nNumber of candidate subsets examined:", iter.format, "\n")
      
      base::cat("\nSolution identified!\n")
      
      base::cat("\nSolution (character):", base::paste(colnames.n.mat[K.star], collapse = " -- "), "\n")
      
      base::cat("\nSolution (numeric):", base::format(base::round(f.K.star, 3), big.mark = ",", nsmall = 3), "\n\n")
      
    }
    
    base::return(base::invisible(base::list(solution.character = colnames.n.mat[K.star], solution.numeric = f.K.star)))
    
  }
  
}