R/print.R

In epiparameter: Classes and Helper Functions for Working with Epidemiological Parameters

#' Print method for `<multi_epiparameter>` class
#'
#' @param x A `<multi_epiparameter>` object.
#' @param n A `numeric` specifying how many `<epiparameter>` objects to print.
#' This argument is passed to [head()] for `list` printing. Default is `NULL`
#' and the number of elements to print is controlled by package [options()].
#' @inheritParams print.epiparameter
#'
#' @return Invisibly returns a `<multi_epiparameter>`. Called for side-effects.
#' @export
#' @examples
#' # entire database
#' db <- epiparameter_db()
#' db
#'
#' # a single disease
#' db <- epiparameter_db(disease = "Ebola")
#' db
#'
#' # a single epi parameter
#' db <- epiparameter_db(epi_name = "offspring distribution")
#' db
print.multi_epiparameter <- function(x, ..., n = NULL) {
  chkDots(...)

  # determine how many <epiparameter> to print
  if (is.null(n)) {
    n <- getOption("epiparameter")$print_max
    if (length(x) > n) {
      n <- getOption("epiparameter")$print_min
    } else {
      n <- length(x)
    }
  }

  n_entries <- length(x)
  extra_n <- n_entries - n

  diseases <- vapply(x, `[[`, FUN.VALUE = character(1), "disease")
  alpha_unique_diseases <- sort(unique(diseases))
  epi_names <- vapply(
    x, `[[`, FUN.VALUE = character(1), "epi_name"
  )
  alpha_unique_epi_names <- sort(unique(epi_names))

  # header
  writeLines(
    pillar::style_subtle(
      cli::pluralize(
        "# ", tr_("List of {n_entries} <epiparameter> object{?s}\n")
      )
    )
  )
  writeLines(
    pillar::style_subtle(
      c(
        tr_("Number of diseases: ", length(alpha_unique_diseases)),
        paste(cli::symbol$pointer, alpha_unique_diseases, collapse = " "),
        tr_("Number of epi parameters: ", length(alpha_unique_epi_names)),
        paste(cli::symbol$pointer, alpha_unique_epi_names, collapse = " ")
      )
    )
  )

  # body
  print(utils::head(x, n = n))

  # footer
  footer <- ""
  if (extra_n >= 1) {
    footer <- c(
      sprintf(tr_("%s more elements"), extra_n),
      tr_("Use `print(n = ...)` to see more elements.\n")
    )
    footer <- paste("#", cli::symbol$info, footer, collapse = "\n")
  }

  writeLines(
    pillar::style_subtle(
      paste0(
        footer,
        "# ", cli::symbol$info,
        " Use `parameter_tbl()` to see a summary table of the parameters.\n",
        "# ", cli::symbol$info, " Explore database online at: ",
        cli::style_hyperlink(
          text = "https://epiverse-trace.github.io/epiparameter/articles/database.html", # nolint line_length_linter
          url = "https://epiverse-trace.github.io/epiparameter/articles/database.html" # nolint line_length_linter
        )
      )
    )
  )
  invisible(x)
}

#' Print method for `<epiparameter>` class
#'
#' @param x An `<epiparameter>` object.
#' @param ... [dots] Extra arguments to be passed to the method.
#'
#' @return Invisibly returns an `<epiparameter>`. Called for side-effects.
#' @export
#'
#' @examples
#' epiparameter <- epiparameter(
#'   disease = "ebola",
#'   epi_name = "incubation_period",
#'   prob_distribution = create_prob_distribution(
#'     prob_distribution = "gamma",
#'     prob_distribution_params = c(shape = 1, scale = 1)
#'   )
#' )
#' epiparameter
print.epiparameter <- function(x, ...) {
  format(x, ...)
}