R/KorAPCorpusStats.R

In RKorAPClient: 'KorAP' Web Service Client Package

#' KorAPCorpusStats class (internal)
#'
#' Internal class for corpus statistics storage. Users work with `corpusStats()` function instead.
#'
#' @keywords internal
#' @include KorAPConnection.R
#' @include logging.R
#'
#' @export
setClass("KorAPCorpusStats", slots = c(vc = "character", documents = "numeric", tokens = "numeric", sentences = "numeric", paragraphs = "numeric", webUIRequestUrl = "character"))

setGeneric("corpusStats", function(kco, ...) standardGeneric("corpusStats"))

#' Get corpus size and statistics
#'
#' Retrieve information about corpus size (documents, tokens, sentences, paragraphs) 
#' for the entire corpus or a virtual corpus subset.
#'
#' @section Usage:
#' ```r
#' # Get statistics for entire corpus
#' kcon <- KorAPConnection()
#' stats <- corpusStats(kcon)
#' 
#' # Get statistics for a specific time period
#' stats <- corpusStats(kcon, "pubDate in 2020")
#' 
#' # Access the number of tokens
#' stats@tokens
#' ```
#'
#' @family corpus analysis
#' @param kco [KorAPConnection()] object (obtained e.g. from `KorAPConnection()`
#' @param vc string describing the virtual corpus. An empty string (default) means the whole corpus, as far as it is license-wise accessible.
#' @param verbose logical. If `TRUE`, additional diagnostics are printed.
#' @param as.df return result as data frame instead of as S4 object?
#' @param cacheAs path to an RDS file to keep the result in. If the file exists and records the same call, it is read back instead of contacting the server; otherwise the query is run and its result stored there. Unlike the connection's `cache`, this file belongs to the caller, which is what keeps an analysis reproducible once the corpus has grown or the scores have changed. Defaults to \code{NULL} (no file).
#' @return Object containing corpus statistics with the following information:
#' \describe{
#'   \item{`vc`}{Virtual corpus definition used (empty string for entire corpus)}
#'   \item{`documents`}{Total number of documents in the (virtual) corpus}
#'   \item{`tokens`}{Total number of word tokens in the (virtual) corpus}
#'   \item{`sentences`}{Total number of sentences in the (virtual) corpus}
#'   \item{`paragraphs`}{Total number of paragraphs in the (virtual) corpus}
#'   \item{`webUIRequestUrl`}{URL to view this corpus subset in KorAP web interface}
#' }
#' When `as.df=TRUE`, returns a data frame with these columns. 
#' When `as.df=FALSE` (default), returns a KorAPCorpusStats object with these values as slots.
#'
#' @importFrom urltools url_encode
#' @examples
#' \dontrun{
#' 
#' kco <- KorAPConnection()
#' 
#' # Get statistics for entire corpus (returns S4 object)
#' stats <- corpusStats(kco)
#' stats@tokens  # Access number of tokens
#' 
#' # Get statistics for newspaper texts from 2017 (as data frame)
#' df <- corpusStats(kco, "pubDate in 2017 & textType=/Zeitung.*/", as.df = TRUE)
#' df$documents  # Access number of documents
#' 
#' # Compare corpus sizes across years
#' years <- 2015:2020
#' sizes <- sapply(years, function(y) {
#'   corpusStats(kco, paste("pubDate in", y))@tokens
#' })
#' }
#'
#' @aliases corpusStats

#' @export
setMethod("corpusStats", "KorAPConnection", function(kco,
                                                     vc = "",
                                                     verbose = kco@verbose,
                                                     as.df = FALSE,
                                                     cacheAs = NULL) {
  cacheRecord <- NULL
  if (!is.null(cacheAs)) {
    cacheAs <- cacheAsFileName(cacheAs)
    cacheRecord <- cacheAsRecord(environment(), NULL, kco)
    cached <- readCacheAs(cacheAs, kco, cacheRecord, "corpus statistics")
    if (!is.null(cached)) {
      return(cached)
    }
  }

  stats <- if (length(vc) > 1) {
    # the names of a named vc vector would end up as row names, which the first
    # bind_rows() drops, so they are kept as a column instead
    vcLabel <- vcLabels(vc)
    # ETA calculation for multiple virtual corpora
    total_items <- length(vc)
    start_time <- Sys.time()
    results <- list()
    individual_times <- numeric(total_items)

    for (i in seq_along(vc)) {
      current_vc <- vc[i]
      item_start_time <- Sys.time()

      # Truncate long vc strings for display
      vc_display <- if (nchar(current_vc) > 50) {
        paste0(substr(current_vc, 1, 47), "...")
      } else {
        current_vc
      }

      # Process current virtual corpus
      result <- corpusStats(kco, current_vc, verbose = FALSE, as.df = TRUE)
      if (!is.null(vcLabel)) {
        result <- tibble::add_column(result, label = vcLabel[i], .after = "vc")
      }
      results[[i]] <- result

      # Record individual processing time
      item_end_time <- Sys.time()
      individual_times[i] <- as.numeric(difftime(item_end_time, item_start_time, units = "secs"))

      # Format item number with proper alignment
      current_item_formatted <- sprintf(paste0("%", nchar(total_items), "d"), i)

      # Calculate timing and ETA after first few items, using cache-aware approach
      if (i >= 2) {
        eta_info <- calculate_sophisticated_eta(individual_times, i, total_items)
        cache_indicator <- get_cache_indicator(eta_info$is_cached)
        eta_display <- format_eta_display(eta_info$eta_seconds, eta_info$estimated_completion_time)

        log_info(verbose, sprintf(
          "Processed vc %s/%d: \"%s\" in %4.1fs%s%s\n",
          current_item_formatted,
          total_items,
          vc_display,
          individual_times[i],
          cache_indicator,
          eta_display
        ))
      } else {
        # First item, show without ETA
        cache_indicator <- get_cache_indicator(individual_times[i] < 0.1)
        log_info(verbose, sprintf(
          "Processed vc %s/%d: \"%s\" in %4.1fs%s\n",
          current_item_formatted,
          total_items,
          vc_display,
          individual_times[i],
          cache_indicator
        ))
      }
    }

    # Final timing summary with cache analysis
    if (verbose && total_items > 1) {
      total_time <- as.numeric(difftime(Sys.time(), start_time, units = "secs"))
      avg_time_per_item <- total_time / total_items
      cached_count <- sum(individual_times < 0.1)
      non_cached_count <- total_items - cached_count

      log_info(verbose, sprintf(
        "Completed processing %d virtual corpora in %s (avg: %4.1fs/item, %d cached, %d non-cached)\n",
        total_items,
        format_duration(total_time),
        avg_time_per_item,
        cached_count,
        non_cached_count
      ))
    }

    stats <- do.call(rbind, results)
    rownames(stats) <- NULL
    stats
  } else {
    url <-
      paste0(
        kco@apiUrl,
        "statistics?cq=",
        URLencode(enc2utf8(vc), reserved = TRUE)
      )
    log_info(verbose, "Getting size of virtual corpus \"", vc, "\"", sep = "")
    res <- apiCall(kco, url)
    webUIRequestUrl <- paste0(kco@KorAPUrl, sprintf("?q=<base/s=t>&cq=%s", url_encode(enc2utf8(vc))))
    if (is.null(res)) {
      res <- data.frame(documents = NA, tokens = NA, sentences = NA, paragraphs = NA)
    }
    log_info(verbose, ": ", res$tokens, " tokens\n")
    if (as.df) {
      data.frame(vc = vc, webUIRequestUrl = webUIRequestUrl, res, stringsAsFactors = FALSE)
    } else {
      new(
        "KorAPCorpusStats",
        vc = vc,
        documents = ifelse(is.logical(res$documents), 0, res$documents),
        tokens = ifelse(is.logical(res$tokens), 0, res$tokens),
        sentences = ifelse(is.logical(res$documents), 0, res$sentences),
        paragraphs = ifelse(is.logical(res$paragraphs), 0, res$paragraphs),
        webUIRequestUrl = webUIRequestUrl
      )
    }
  }

  if (!is.null(cacheAs)) {
    writeCacheAs(cacheAs, kco, cacheRecord, "corpus statistics", stats)
  }
  stats
})

#' @rdname KorAPCorpusStats-class
#' @param object KorAPCorpusStats object
#' @export
setMethod("show", "KorAPCorpusStats", function(object) {
  cat("<KorAPCorpusStats>", "\n")
  if (object@vc == "") {
    cat("The whole corpus")
  } else {
    cat("The virtual corpus described by \"", object@vc, "\"", sep = "")
  }
  cat(
    " contains", formatC(object@tokens, format = "f", digits = 0, big.mark = ","), "tokens in",
    formatC(object@sentences, format = "d", big.mark = ","), "sentences in",
    formatC(object@documents, format = "d", big.mark = ","), "documents.\n"
  )
})