R/venn.R

In eulerr: Area-Proportional Euler and Venn Diagrams

#' Venn diagrams
#'
#' This function fits Venn diagrams using an interface that is
#' almost identical to [euler()]. Strictly speaking,
#' Venn diagrams are Euler diagrams where every intersection is visible,
#' regardless of whether or not it is zero. In almost every incarnation of
#' Venn diagrams, however, the areas in the diagram are also
#' *non-proportional* to the input; this is also the case here.
#'
#' @inheritParams euler
#' @param shape geometric shape used in the diagram, either `"ellipse"` (the
#'   default, supporting up to five sets) or `"rotated_rectangle"` (supporting
#'   up to four sets). Rotated rectangles draw a true four-set Venn diagram in
#'   which all 15 regions are visible.
#'
#' @return Returns an object of class `'eulerr_venn', 'venn', 'euler'` with items
#'   \item{shapes}{a data frame of the precomputed shape parameters (one row
#'     per set). For `shape = "ellipse"` the columns are `type, h, k, a, b,
#'     phi`; for `shape = "rotated_rectangle"` they are `type, h, k, width,
#'     height, phi`.}
#'   \item{ellipses}{the legacy 5-column data frame
#'     (`h, k, a, b, phi`), kept for back-compat alongside the canonical
#'     `shapes` slot. Only present for `shape = "ellipse"`.}
#'   \item{original.values}{set relationships in the input}
#'   \item{fitted.values}{set relationships in the solution}
#'
#' @seealso [plot.eulerr_venn()], [print.eulerr_venn()], [euler()]
#'
#' @export
#'
#' @examples
#' # The trivial version
#' f1 <- venn(5, names = letters[1:5])
#' plot(f1)
#'
#' # Using data (a numeric vector)
#' f2 <- venn(c(A = 1, "B&C" = 3, "A&D" = 0.3))
venn <- function(combinations, ...) {
  UseMethod("venn")
}

#' @describeIn venn a named numeric vector, with
#'   combinations separated by an ampersand, for instance `A&B = 10`.
#'   Missing combinations are treated as being 0.
#' @param names a character vector for the names of each set of the same
#'   length as 'combinations'. Must not be `NULL` if `combinations` is a
#'   one-length numeric.
#' @export
venn.default <- function(
  combinations,
  input = c("disjoint", "union"),
  shape = c("ellipse", "rotated_rectangle"),
  names = letters[length(combinations)],
  ...
) {
  shape <- match.arg(shape)
  if (is.numeric(combinations) && length(combinations) == 1) {
    if (is.null(names)) {
      stop(
        "'names' must not be NULL when 'combinations' is a length ",
        "one integer."
      )
    }

    if (combinations < 1) {
      stop(
        "'combinations' cannot be less than 1 when 'combinations' is a ",
        "length one integer."
      )
    }

    if (combinations > 5) {
      stop("'venn()' only supports diagrams with up to five sets.")
    }

    if (length(names) != combinations) {
      stop("'names' must be as long as 'combinations'.")
    }

    combo_names <- all_set_combinations(names)
    combinations <- stats::setNames(
      rep.int(1, length(combo_names)),
      combo_names
    )
  } else {
    n_combinations <- length(unique(unlist(strsplit(names(combinations), "&"))))

    if (n_combinations > 5) {
      stop("'venn()' only supports diagrams with up to five sets")
    }
  }

  fit_diagram(
    combinations,
    type = "venn",
    input = input,
    shape = shape,
    control = list(),
    ...
  )
}

#' @describeIn venn A table with `max(dim(x)) < 3`.
#' @export
#'
#' @examples
#'
#' # The table method
#' venn(pain, factor_names = FALSE)
venn.table <- function(combinations, ...) {
  x <- as.data.frame(combinations)
  venn(x[, names(x) != "Freq"], weights = x$Freq, ...)
}

#' @describeIn venn a `data.frame` of logicals, binary integers, or
#'   factors.
#' @export
#' @examples
#'
#' # Using grouping via the 'by' argument through the data.frame method
#' venn(fruits, by = list(sex, age))
#'
venn.data.frame <- function(
  combinations,
  weights = NULL,
  by = NULL,
  sep = "_",
  factor_names = TRUE,
  ...
) {
  by <- substitute(by)
  facs <- eval(by, combinations)

  combinations <- parse_dataframe(
    combinations,
    weights,
    by,
    facs,
    sep,
    factor_names
  )

  if (is.list(combinations)) {
    out <- lapply(combinations, venn, ...)
    class(out) <- c("eulerr_venn", "venn", "euler", "list")
    attr(out, "groups") <- attr(combinations, "groups")
  } else {
    out <- venn(combinations, ...)
  }

  out
}

#' @describeIn venn a matrix that can be converted to a data.frame of logicals
#'   (as in the description above) via [base::as.data.frame.matrix()].
#' @export
#' @inheritParams euler
#'
#' @examples
#'
#' # Using the matrix method
#' venn(organisms)
#'
#' # Using weights
#' venn(organisms, weights = c(10, 20, 5, 4, 8, 9, 2))
venn.matrix <- function(combinations, ...) {
  venn(as.data.frame(combinations), ...)
}

#' @describeIn venn a list of vectors, each vector giving the contents of
#'   that set (with no duplicates). Vectors in the list do not need to be named.
#' @export
#' @inheritParams euler
#' @examples
#'
#' # A venn diagram from a list of sample spaces (the list method)
#' venn(plants[c("erigenia", "solanum", "cynodon")])
venn.list <- function(combinations, ...) {
  venn(parse_list(combinations), input = "disjoint", ...)
}