R/cidian.R

In cidian: Read and Parse Chinese Input-Method Dictionaries

#' List supported dictionary formats
#'
#' @return A character vector of format identifiers accepted by
#'   `read_cidian()`.
#' @export
#' @examples
#' cidian_formats()
cidian_formats <- function() {
  c("scel", "qcel", "qpyd", "bdict", "bcd")
}

#' Read a Chinese input-method dictionary
#'
#' `read_cidian()` reads a supported binary dictionary and returns a common
#' `cidian_dictionary` object. The parser preserves source order and does
#' not normalize, sort, or deduplicate entries.
#'
#' The format is inferred from the file extension when `format` is omitted or
#' `NULL`. Supply `format` when the file has no extension or its extension is
#' wrong.
#'
#' @param path A path to a dictionary file.
#' @param ... Must be empty.
#' @param format A format name, with or without a leading dot. Supported
#'   values are `"scel"`, `"qcel"`, `"qpyd"`, `"bdict"`, and `"bcd"`.
#'
#' @return A `cidian_dictionary` object containing `metadata`, `entries`, and
#'   `format` fields. The `entries$code` column is a list-column of character
#'   vectors, and `entries$weight` is a numeric vector.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' x
read_cidian <- function(
  path,
  ...,
  format = c("scel", "qcel", "qpyd", "bdict", "bcd")
) {
  rlang::check_dots_empty()

  # Check the path
  rlang::check_string(path, allow_empty = FALSE, arg = "path")
  path <- path.expand(path)
  if (!file.exists(path)) {
    cli::cli_abort(c(
      "Dictionary file does not exist.",
      "x" = "Cannot read {.path {path}}."
    ))
  }

  # Check the format
  if (missing(format) || is.null(format)) {
    format <- tolower(tools::file_ext(path))
    rlang::arg_match(format, values = cidian_formats(), error_arg = "format")
  } else {
    rlang::check_string(format, allow_empty = FALSE, arg = "format")
    format <- tolower(sub("^\\.", "", format))
    rlang::arg_match(format, values = cidian_formats(), error_arg = "format")
  }

  result <- tryCatch(
    parse_cidian(path, format),
    error = function(error) {
      cli::cli_abort(
        c(
          "Failed to parse dictionary file.",
          "x" = "{conditionMessage(error)}"
        ),
        parent = error
      )
    }
  )
  class(result) <- c("cidian_dictionary", "list")
  result
}

#' Write dictionary entries to a text file
#'
#' `write_words()` writes the word of every entry in `x` to `path`,
#' one word per line, preserving the source order.
#'
#' When `path` already exists, the function asks for confirmation unless
#' `overwrite` is given explicitly.
#'
#' @param x A `cidian_dictionary` object.
#' @param path A path to the output file.
#' @param ... Must be empty.
#' @param overwrite Whether to replace `path` when it already exists. `NULL`
#'   (the default) asks interactively; `TRUE` overwrites without asking;
#'   `FALSE` errors.
#'
#' @return The `path`, invisibly.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' write_words(x, tempfile(fileext = ".txt"))
write_words <- function(x, path, ..., overwrite = NULL) {
  rlang::check_dots_empty()

  validate_cidian_dictionary(x)
  rlang::check_string(path, allow_empty = FALSE, arg = "path")
  rlang::check_bool(overwrite, allow_null = TRUE)

  path <- path.expand(path)

  if (file.exists(path)) {
    if (is.null(overwrite)) {
      proceed <- utils::askYesNo(
        paste0("Overwrite ", path, "?"),
        default = FALSE
      )
      if (!isTRUE(proceed)) {
        cli::cli_abort("Not overwriting {.path {path}}.")
      }
    } else if (!isTRUE(overwrite)) {
      cli::cli_abort(c(
        "Output file already exists.",
        "i" = "Supply {.code overwrite = TRUE} to replace {.path {path}}."
      ))
    }
  }

  writeLines(cidian_entries(x)$word, path, useBytes = TRUE)
  invisible(path)
}

#' Extract dictionary entries
#'
#' @param x A `cidian_dictionary` object.
#'
#' @return A base `data.frame` with `word`, `code`, and `weight` columns.
#'   `code` is a list-column of character vectors and `weight` is numeric.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' head(cidian_entries(x))
cidian_entries <- function(x) {
  validate_cidian_dictionary(x)
  x$entries
}

#' Extract dictionary metadata
#'
#' @param x A `cidian_dictionary` object.
#'
#' @return A list with `name`, `category`, `description`, and `extra` fields.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' cidian_metadata(x)
cidian_metadata <- function(x) {
  validate_cidian_dictionary(x)
  x$metadata
}

#' Print a dictionary summary
#'
#' @param x A `cidian_dictionary` object.
#' @param ... Must be empty.
#'
#' @return Invisibly returns a `summary.cidian_dictionary` object summarizing `x`.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' print(x)
print.cidian_dictionary <- function(x, ...) {
  rlang::check_dots_empty()
  validate_cidian_dictionary(x)
  print(summary(x))
}

#' Convert a dictionary to a data frame
#'
#' @param x A `cidian_dictionary` object.
#' @param ... Must be empty.
#'
#' @return A base `data.frame` with `word`, `code`, and `weight` columns.
#'   `code` is a list-column of character vectors and `weight` is numeric.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' head(as.data.frame(x))
as.data.frame.cidian_dictionary <- function(x, ...) {
  rlang::check_dots_empty()
  validate_cidian_dictionary(x)
  cidian_entries(x)
}

#' Summarize a dictionary
#'
#' @param object A `cidian_dictionary` object.
#' @param ... Must be empty.
#'
#' @return An object of class `summary.cidian_dictionary` containing the
#'   format, metadata, entry count, and number of weighted entries.
#' @export
#' @examples
#' x <- read_cidian(system.file("extdata", "computer.qcel", package = "cidian"))
#' summary(x)
summary.cidian_dictionary <- function(object, ...) {
  rlang::check_dots_empty()
  validate_cidian_dictionary(object)

  metadata <- cidian_metadata(object)
  entries <- cidian_entries(object)
  result <- list(
    format = object$format,
    name = metadata$name,
    category = metadata$category,
    description = metadata$description,
    entries = nrow(entries),
    weighted_entries = sum(!is.na(entries$weight))
  )
  class(result) <- "summary.cidian_dictionary"
  result
}

#' @export
#' @noRd
print.summary.cidian_dictionary <- function(x, ...) {
  cat("<summary.cidian_dictionary>\n")
  cat("Format:", toupper(x$format), "\n")
  if (!is.null(x$name)) {
    cat("Name: ", x$name, "\n", sep = "")
  }
  if (!is.null(x$category)) {
    cat("Category: ", x$category, "\n", sep = "")
  }
  cat(
    "Entries:",
    format(x$entries, big.mark = ",", trim = TRUE),
    "\n"
  )
  cat(
    "Weighted entries:",
    format(x$weighted_entries, big.mark = ",", trim = TRUE),
    "\n"
  )

  invisible(x)
}

validate_cidian_dictionary <- function(x) {
  if (!inherits(x, "cidian_dictionary") || !is.list(x)) {
    cli::cli_abort(
      "{.arg x} must be a {.cls cidian_dictionary} object.",
      class = "cidian_object_error"
    )
  }
  required <- c("metadata", "entries", "format")
  if (!all(required %in% names(x))) {
    cli::cli_abort(
      "{.arg x} is not a valid {.cls cidian_dictionary} object.",
      class = "cidian_object_error"
    )
  }
  invisible(x)
}