#' Build a Term-Frequency Table
#'
#' @description Build a term-frequency table from document text.
#'   A term is a single word or, when n-gram tokenization is enabled, an ordered
#'   sequence of words.
#'
#' @param docs 'list' or 'character' vector.
#'   Document text to analyze. Each element holds the extracted text of a single
#'   document and may itself be a character vector (its pieces are concatenated).
#'   `NA` values are dropped. If unnamed, elements are numbered sequentially.
#'
#' @param ngmin,ngmax 'integer' numbers.
#'   Minimum and maximum number of words per term (n-gram). The default
#'   (`ngmin = ngmax = 1`) counts single words. Values greater than one require the
#'   \pkg{RWeka} package and that the `JAVA_HOME` environment variable point to a
#'   Java installation. Recommended for a single document only.
#'
#' @param sparse 'numeric' number greater than 0 and less than 1, or `NULL`.
#'   Maximum allowed sparsity: terms appearing in a smaller proportion of documents
#'   are removed. For example, `sparse = 0.99` removes terms more sparse than 0.99,
#'   while `sparse = 0.01` retains only terms appearing in nearly every document.
#'   The default (`NULL`) disables sparse-term removal.
#'
#' @details Documents are cleaned before counting: URLs, escaped unicode sequences,
#'   HTML tags, and selected punctuation are removed; text is lowercased; numbers,
#'   English and SMART stopwords, and remaining punctuation are stripped; and
#'   whitespace is collapsed. HTML entities are decoded when the \pkg{textutils}
#'   package is available. When n-grams are requested, terms containing a repeated
#'   word are discarded.
#'
#' @return A 'data.frame' term-frequency table with columns `term`, `pub_id`, and
#'   `freq`, giving the number of times each term occurs in each document. Rows with
#'   a zero count are omitted, and the table is sorted by term (ascending) then
#'   frequency (descending).
#'
#' @author J.C. Fisher, U.S. Geological Survey, Idaho Water Science Center
#'
#' @seealso [`search_terms`] to search within the resulting table, and
#'   [`make_wordcloud`] to create a word cloud from it.
#'
#' @export
#'
#' @examples
#' d <- c(
#'   "The quick brown fox jumps over the lazy lazy dog.",
#'   "Pack my brown box.",
#'   "Jazz fly brown dog."
#' ) |>
#'   mine_text()
#'
#' d <- list(
#'   "A" = "The quick brown fox jumps over the lazy lazy dog.",
#'   "B" = c("Pack my brown box.", NA, "Jazz fly brown dog."),
#'   "C" = NA_character_
#' ) |>
#'   mine_text()

mine_text <- function(
  docs,
  ngmin = 1,
  ngmax = ngmin,
  sparse = NULL
) {
  # check arguments
  checkmate::assert(
    checkmate::check_list(docs),
    checkmate::check_character(docs)
  )
  checkmate::assert_count(ngmin, positive = TRUE)
  checkmate::assert_int(ngmax, lower = ngmin)
  checkmate::assert_number(sparse, lower = 0.001, upper = 0.999, null.ok = TRUE)

  # check system dependencies for n-gram tokenization up front
  if (ngmax > 1L) {
    if (!checkmate::test_directory_exists(Sys.getenv("JAVA_HOME"), access = "r")) {
      stop("Word n-grams require JAVA_HOME to point to a Java installation", call. = FALSE)
    }
    if (!requireNamespace("RWeka", quietly = TRUE)) {
      stop("Word n-grams require the 'RWeka' package", call. = FALSE)
    }
  }

  # assign names to unnamed documents
  if (is.null(names(docs))) {
    names(docs) <- as.character(seq_along(docs))
  }

  # concatenate each document's pieces into a single string, dropping NA
  docs <- vapply(
    docs,
    FUN = function(x) {
      stats::na.omit(x) |>
        as.character() |>
        paste(collapse = " ")
    },
    FUN.VALUE = character(1)
  )

  # decode HTML entities when textutils is available
  if (requireNamespace("textutils", quietly = TRUE)) {
    docs <- textutils::HTMLdecode(docs)
  }

  # define transformation functions
  remove_url <- tm::content_transformer(
    function(x) gsub("(f|ht)tp(s?)://\\S+", "", x, perl = TRUE)
  )
  remove_pat <- tm::content_transformer(
    function(x, pattern) gsub(pattern, " ", x)
  )

  # build and clean the volatile corpus
  corpus <- tm::VectorSource(docs) |>
    tm::VCorpus() |>
    tm::tm_map(remove_url) |>
    tm::tm_map(remove_pat, "\\\\u[0-9A-Fa-f]{4}") |>
    tm::tm_map(remove_pat, "\\\\n") |>
    tm::tm_map(remove_pat, "<.*?>") |>
    tm::tm_map(remove_pat, "/") |>
    tm::tm_map(remove_pat, "@") |>
    tm::tm_map(remove_pat, "\\|") |>
    tm::tm_map(tm::content_transformer(tolower)) |>
    tm::tm_map(tm::removeNumbers) |>
    tm::tm_map(tm::removeWords, tm::stopwords("english")) |>
    tm::tm_map(tm::removeWords, tm::stopwords("SMART")) |>
    tm::tm_map(tm::removePunctuation, preserve_intra_word_dashes = TRUE) |>
    tm::tm_map(tm::stripWhitespace)

  # tag each corpus document with its identifier
  for (i in seq_along(corpus)) {
    corpus[[i]]$meta$id <- names(docs)[i]
  }

  # define the n-gram tokenizer when more than single words are requested
  control <- list()
  if (ngmax > 1L) {
    control <- list(
      "tokenize" = function(x) {
        RWeka::NGramTokenizer(
          x,
          control = RWeka::Weka_control(min = ngmin, max = ngmax)
        )
      }
    )
  }

  # coerce the corpus to a term-document matrix
  tdm <- tm::TermDocumentMatrix(corpus, control = control)

  # remove sparse terms
  if (!is.null(sparse)) {
    tdm <- tm::removeSparseTerms(tdm, sparse = sparse)
  }

  # convert to a long-format frequency table
  d <- as.table(tdm) |>
    as.data.frame(stringsAsFactors = TRUE)
  colnames(d) <- c("term", "pub_id", "freq")
  d$freq <- as.integer(d$freq)

  # drop zero-frequency rows
  d <- d[d$freq > 0, ]

  # return early when no terms remain (e.g. all-NA input)
  if (nrow(d) == 0L) {
    return(droplevels(d))
  }

  # for n-grams, drop terms containing a repeated word
  if (ngmax > 1L) {
    has_dup <- as.character(d$term) |>
      strsplit(split = " ") |>
      vapply(FUN = anyDuplicated, FUN.VALUE = integer(1)) |>
      as.logical()
    d <- d[!has_dup, ]
  }

  # sort by term (ascending), then frequency (descending)
  idxs <- order(d$term, d$freq, decreasing = c(FALSE, TRUE), method = "radix")
  d <- d[idxs, ]

  # clear row names and drop unused factor levels
  rownames(d) <- NULL
  droplevels(d)
}
