R/eulerr_options.R

In eulerr: Area-Proportional Euler and Venn Diagrams

#' Get or set global graphical parameters for eulerr
#'
#' This function provides a means to set default parameters for functions
#' in eulerr. Query [eulerr_options()] (without any
#' argument) to see all the available options and read more about
#' the plot-related ones in [grid::gpar()] and [graphics::par()].
#'
#' Currently, the following items will be considered:
#' \describe{
#'   \item{pointsize}{size in pts to be used as basis for fontsizes and
#'   some margin sizes in the resulting plot}#'
#'   \item{fills}{a list of items `fill` and `alpha`}
#'   \item{patterns}{a list of items `type`, `angle`, `col`, `lwd`, and `alpha`}
#'   \item{edges}{a list of items `col`, `alpha`, `lex`, `lwd`, and `lty`}
#'   \item{labels}{a list of items `rot`,
#'   `col`, `alpha`, `fontsize`, `cex`, `fontfamily`, `fontface`,
#'   `lineheight`, and `font`}
#'   \item{quantities}{a list of items `type`, `template`, `format`, `total`, `rot`,
#'   `col`, `alpha`, `fontsize`, `cex`, `fontfamily`,
#'   `lineheight`, and `font`}
#'   \item{annotations}{a list of items `rot`, `col`, `alpha`, `fontsize`,
#'   `cex`, `fontfamily`, `lineheight`, `font`, and `labels` (a named
#'   character vector keyed by subset name). Used to add a third stacked
#'   text element per region below the quantity.}
#'   \item{glyphs}{defaults for dot and member-label glyph placement and
#'   styling, including `mode`, `arrangement`, `gap`, `seed`, `radius`,
#'   `scale`, `min_scale`, `max_attempts`, `max_items`, and graphical
#'   parameters.}
#'   \item{strips}{`col`, `alpha`, `fontsize`, `cex`, `fontfamily`,
#'   `lineheight`, and `font`}
#'   \item{legend}{arguments to [grid::legendGrob()] as well as `col`, `alpha`,
#'   `fontsize`, `cex`, `symbol_size` (symbol size multiplier, independent of text
#'   size; defaults to `cex` if `NULL`), `fontfamily`, `lineheight`, and `font`}
#'   \item{main}{arguments to [grid::textGrob()]}
#'   \item{complement}{a list of styling defaults for the container box
#'   and its complement label drawn when [euler()] is called with
#'   `complement =`. Items: `fill`, `alpha`, `col`, `lty`, `lwd`, `lex`,
#'   `fontsize`, `cex`, `font`, `fontfamily`, `lineheight`. The default
#'   `lty = 2` draws the container with a dashed outline.}
#'   \item{padding}{a [grid::unit()] giving the padding between various
#'   elements in plots from [plot.euler()], which you can change
#'   if you, for instance, want to increase spacing between labels,
#'   quantities, and percentages.}
#'   \item{margin}{a [grid::unit()] giving the fixed margin reserved
#'   around the diagram inside the plot canvas. Increase it if shape
#'   outlines or exterior labels are clipped at the plot edge, or
#'   decrease it to give the diagram more room. A fixed (rather than
#'   relative) unit is recommended so that the margin keeps pace with
#'   stroke width and label text, which are themselves fixed sizes.}
#'   \item{composition}{a list controlling how `eulergram` objects are
#'   arranged when composed via `|` or `/`. Contains a single `spacing`
#'   item (a [grid::unit()]) that sets the gap between adjacent plots.}
#' }
#'
#' @param ... objects to update the global graphical parameters for \pkg{eulerr}
#'   with.
#'
#' @return This function gets or sets updates in the global environment
#'   that are used in [plot.euler()].
#' @export
#' @seealso [plot.euler()], [grid::gpar()], [graphics::par()]
#'
#' @examples
#' eulerr_options(edges = list(col = "blue"), fontsize = 10)
#' eulerr_options(n_threads = 2)
eulerr_options <- function(...) {
  new <- list(...)
  if (is.null(names(new)) && length(new) == 1L && is.list(new[[1L]])) {
    new <- new[[1L]]
  }
  old <- .eulerr_env$options
  if (length(new) == 0L) {
    return(old)
  }
  nm <- names(new)
  if (is.null(nm)) {
    return(old[unlist(new)])
  }
  is_named <- nm != ""
  if (!all(is_named)) {
    nm[!is_named] <- unlist(new[!is_named])
  }
  out <- old[nm]
  names(out) <- nm
  nm <- nm[is_named]
  .eulerr_env$options <- update_list(old, new[nm])
  pointsize <- new$pointsize
  if (!is.null(pointsize)) {
    .eulerr_env$options <- update_list(
      .eulerr_env$options,
      list(
        labels = list(fontsize = pointsize),
        quantities = list(fontsize = pointsize),
        annotations = list(fontsize = pointsize),
        glyphs = list(fontsize = pointsize),
        strips = list(fontsize = pointsize),
        legend = list(fontsize = pointsize),
        main = list(fontsize = pointsize),
        pointsize = pointsize
      )
    )
  }
  invisible(out)
}

#' Default options for eulerr
#'
#' @return default options for eulerr
#' @keywords internal
eulerr_default_options <- function() {
  list(
    pointsize = 12,
    fills = list(
      fill = function(n) {
        c(
          "white",
          "grey85",
          "lightblue",
          "lightcoral",
          "lemonchiffon",
          "plum3",
          "aquamarine2",
          "grey55",
          "steelblue2",
          "lightsalmon",
          "lightpink",
          "lightgoldenrod"
        )[seq_len(n)]
      },
      alpha = 1,
      mode = "disjoint"
    ),
    patterns = list(
      type = NA_character_,
      angle = 45,
      col = 1L,
      lwd = 0.5,
      alpha = 1,
      lex = 1,
      mode = "disjoint"
    ),
    edges = list(
      col = 1L,
      alpha = 1,
      lty = 1L,
      lwd = 1,
      lex = 1
    ),
    labels = list(
      rot = 0,
      col = 1L,
      alpha = 1,
      fontsize = 12,
      cex = 1,
      fontfamily = "",
      lineheight = 1.2,
      font = 2,
      position = "inside",
      angular_steps = 180L,
      placement = "raycast",
      margin = NULL,
      tether = "poi",
      gap = NULL,
      force_directed = list(iterations = NULL),
      elbow = list(min_gap = NULL),
      leader = list(
        col = NULL,
        alpha = 0.6,
        lwd = 1,
        lty = 2,
        lex = 1
      )
    ),
    quantities = list(
      type = "counts",
      template = NULL,
      format = NULL,
      total = NULL,
      rot = 0,
      col = 1L,
      alpha = 1,
      fontsize = 12,
      cex = 1,
      fontfamily = "",
      lineheight = 1.2,
      font = 1
    ),
    annotations = list(
      labels = NULL,
      rot = 0,
      col = 1L,
      alpha = 1,
      fontsize = 12,
      cex = 0.8,
      fontfamily = "",
      lineheight = 1.2,
      font = 1
    ),
    glyphs = list(
      mode = "dots",
      arrangement = "uniform",
      gap = 0.25,
      seed = 0,
      radius = NULL,
      scale = NULL,
      min_scale = 0.35,
      max_attempts = 300L,
      max_items = NULL,
      fill = "white",
      col = 1L,
      alpha = 1,
      lwd = 0.5,
      lty = 1L,
      lex = 1,
      fontsize = 12,
      cex = 0.8,
      fontfamily = "",
      lineheight = 1.2,
      font = 1
    ),
    strips = list(
      cex = 1L,
      col = 1L,
      alpha = 1,
      fontsize = 12,
      fontfamily = "",
      lineheight = 1.2,
      rot = 0,
      font = 4
    ),
    legend = list(
      side = "right",
      cex = 1,
      symbol_size = NULL,
      fontsize = 12,
      font = 1,
      fontfamily = "",
      labels = NULL,
      byrow = FALSE,
      do.lines = FALSE,
      lines.first = TRUE,
      hgap = grid::unit(1, "lines"),
      vgap = grid::unit(0.25, "lines"),
      default.units = "lines",
      pch = 21
    ),
    main = list(
      label = NULL,
      x = grid::unit(0.5, "npc"),
      y = grid::unit(0.5, "npc"),
      just = "center",
      hjust = NULL,
      vjust = NULL,
      rot = 0,
      check.overlap = FALSE,
      default.units = "npc",
      cex = 1.5,
      fontsize = 12,
      font = 1,
      fontfamily = "",
      col = 1,
      lineheight = 1.2,
      alpha = 1
    ),
    complement = list(
      fill = "transparent",
      alpha = 1,
      col = 1L,
      lty = 2L,
      lwd = 1,
      lex = 1,
      fontsize = 12,
      cex = 1,
      font = 1,
      fontfamily = "",
      lineheight = 1.2,
      placement = "raycast",
      margin = NULL,
      tether = "poi",
      gap = NULL,
      force_directed = list(iterations = NULL),
      elbow = list(min_gap = NULL),
      leader = list(
        col = NULL,
        alpha = 0.6,
        lwd = 1,
        lty = 2,
        lex = 1
      )
    ),
    padding = grid::unit(0.4, "lines"),
    margin = grid::unit(6, "pt"),
    composition = list(
      spacing = grid::unit(1, "lines")
    )
  )
}