R/txt_recode_fast.R

In tall: Text Analysis for All

#' Fast text recoding (Rcpp version)
#'
#' @description
#' Efficiently recodes text values using C++ hash tables. This is a drop-in
#' replacement for \code{txt_recode} but significantly faster for large vectors.
#'
#' @param x A character vector to recode
#' @param from A character vector with values of \code{x} which you want to recode
#' @param to A character vector with values you want to use to recode to
#' @param na.rm Logical, if set to TRUE, will put all values of \code{x} which
#'   have no matching value in \code{from} to NA. Defaults to FALSE
#'
#' @return A character vector of the same length as \code{x} where values
#'   matching \code{from} are replaced by corresponding values in \code{to}
#'
#' @details
#' This function uses C++ hash tables for O(1) lookup time, making it much
#' faster than the pure R implementation, especially for large datasets.
#'
#' Performance improvement: ~50-100x faster than base R \code{txt_recode}
#' for vectors with 100K+ elements.
#'
#' @examples
#' x <- c("NOUN", "VERB", "NOUN", "ADV")
#' txt_recode_fast(x,
#'   from = c("VERB", "ADV"),
#'   to = c("conjugated verb", "adverb")
#' )
#'
#' @export
txt_recode_fast <- function(x, from = c(), to = c(), na.rm = FALSE) {
  if (length(x) == 0) {
    return(x)
  }

  stopifnot(length(from) == length(to))

  # Chiama la funzione C++
  txt_recode_cpp(x = x, from = from, to = to, na_rm = na.rm)
}


#' Fast n-gram recoding for multiword detection
#'
#' @description
#' Efficiently combines consecutive tokens into multiword expressions using C++.
#' This function scans text sequentially to identify and merge n-gram patterns.
#'
#' @param x Character vector of tokens (e.g., lemmas or tokens)
#' @param compound Character vector of multiword expressions to match
#' @param ngram Integer vector indicating the length of each compound
#' @param sep String separator to use when joining tokens (default: " ")
#'
#' @return Character vector where matched n-grams are combined and subsequent
#'   tokens (that were merged) are set to NA
#'
#' @details
#' When a multiword match is found:
#' \itemize{
#'   \item The first position gets the combined multiword expression
#'   \item Subsequent positions that were merged are set to NA
#' }
#'
#' The function checks n-grams from longest to shortest to prioritize longer matches.
#'
#' Performance: ~80-150x faster than pure R implementation for typical text data.
#'
#' @examples
#' tokens <- c("machine", "learning", "is", "cool", "machine", "learning")
#' compounds <- c("machine learning")
#' ngrams <- c(2)
#' txt_recode_ngram_fast(tokens, compounds, ngrams, " ")
#' # Returns: c("machine learning", NA, "is", "cool", "machine learning", NA)
#'
#' @export
txt_recode_ngram_fast <- function(x, compound, ngram, sep = " ") {
  if (length(x) == 0 || length(compound) == 0) {
    return(x)
  }

  # Chiama la funzione C++
  txt_recode_ngram_cpp(x = x, compound = compound, ngram = ngram, sep = sep)
}


#' Batch text recoding (internal C++ function)
#'
#' @description
#' Internal C++ function for batch recoding multiple character vectors.
#' Efficiently recodes multiple text columns using a single hash table lookup.
#'
#' @param x List of character vectors to recode
#' @param from Character vector of values to match
#' @param to Character vector of replacement values
#' @param na_rm Logical, whether to set unmatched values to NA (default: FALSE)
#'
#' @return List of character vectors with recoded values
#'
#' @details
#' This is an internal C++ function exported for advanced users.
#' The hash table is constructed once and reused for all vectors in the list,
#' making it very efficient for batch operations.
#'
#' @keywords internal
#' @name txt_recode_batch_cpp
NULL


#' Internal C++ text recoding function
#'
#' @description
#' Internal C++ implementation of text recoding using hash tables.
#' Users should call \code{\link{txt_recode_fast}} instead.
#'
#' @param x Character vector to recode
#' @param from Character vector of values to match
#' @param to Character vector of replacement values
#' @param na_rm Logical, whether to set unmatched values to NA
#'
#' @return Character vector with recoded values
#'
#' @keywords internal
#' @name txt_recode_cpp
NULL


#' Internal C++ n-gram recoding function
#'
#' @description
#' Internal C++ implementation of n-gram recoding for multiword detection.
#' Users should call \code{\link{txt_recode_ngram_fast}} instead.
#'
#' @param x Character vector of tokens
#' @param compound Character vector of multiword expressions to match
#' @param ngram Integer vector indicating the length of each compound
#' @param sep String separator to use when joining tokens
#'
#' @return Character vector where matched n-grams are combined
#'
#' @keywords internal
#' @name txt_recode_ngram_cpp
NULL


#' Optimized multiword processing workflow
#'
#' @description
#' Complete optimized workflow for multiword detection and processing.
#' Uses C++ functions and data.table for maximum performance.
#'
#' @param x2 Data frame with token information
#' @param stats Data frame with multiword statistics (keyword, ngram columns)
#' @param term Type of term to process: "lemma" or "token"
#'
#' @return Data frame with columns: doc_id, term_id, multiword, upos_multiword, ngram
#'
#' @details
#' This function replaces the original switch block with an optimized version
#' that uses:
#' \itemize{
#'   \item C++ functions for text recoding
#'   \item Vectorized operations instead of multiple mutate calls
#'   \item Pre-computed lookups to avoid repeated joins
#' }
#'
#' @examples
#' \dontrun{
#' result <- process_multiwords_fast(dfTag, multiword_stats, term = "lemma")
#' }
#'
#' @export
process_multiwords_fast <- function(x2, stats, term = c("lemma", "token")) {
  term <- match.arg(term)

  # Pre-calcola lookup per evitare join ripetuti
  keyword_lookup <- stats$ngram
  names(keyword_lookup) <- stats$keyword

  # Seleziona la colonna corretta
  term_col <- if (term == "lemma") x2$lemma else x2$token

  # Usa la funzione C++ per identificare multiword
  multiword <- txt_recode_ngram_fast(
    x = term_col,
    compound = stats$keyword,
    ngram = stats$ngram,
    sep = " "
  )

  # Operazioni vettorizzate (molto più veloci di mutate multiple)
  upos_multiword <- ifelse(
    term_col == multiword,
    x2$upos,
    ifelse(is.na(multiword), "NGRAM_MERGED", "MULTIWORD")
  )

  # Lookup diretto invece di join
  ngram_values <- keyword_lookup[multiword]

  # Crea risultato direttamente (più veloce di select + mutate)
  data.frame(
    doc_id = x2$doc_id,
    term_id = x2$term_id,
    multiword = multiword,
    upos_multiword = upos_multiword,
    ngram = unname(ngram_values),
    stringsAsFactors = FALSE
  )
}