FreesearchR/R/plot_euler.R

#' Area proportional venn diagrams
#'
#' @description
#' THis is slightly modified from https://gist.github.com/danlooo/d23d8bcf8856c7dd8e86266097404ded
#'
#' This functions uses eulerr::euler to plot area proportional venn diagramms
#' but plots it using ggplot2
#'
#' @param combinations set relationships as a named numeric vector, matrix, or
#' data.frame(See `eulerr::euler`)
#' @param show_quantities whether to show number of intersecting elements
#' @param show_labels whether to show set names
#' @param ... further arguments passed to eulerr::euler
ggeulerr <- function(
    combinations,
    show_quantities = TRUE,
    show_labels = TRUE,
    ...) {
  # browser()
  data <-
    eulerr::euler(combinations = combinations, ...) |>
    plot(quantities = show_quantities) |>
    purrr::pluck("data")


  tibble::as_tibble(data$ellipses, rownames = "Variables") |>
    ggplot2::ggplot() +
    ggforce::geom_ellipse(
      mapping = ggplot2::aes(
        x0 = h, y0 = k, a = a, b = b, angle = 0, fill = Variables
      ),
      alpha = 0.5,
      linewidth = 1.5
    ) +
    ggplot2::geom_text(
      data = {
        data$centers |>
          dplyr::mutate(
            label = labels |> purrr::map2(quantities, ~ {
              if (!is.na(.x) && !is.na(.y) && show_labels) {
                paste0(.x, "\n", sprintf(.y, fmt = "%.2g"))
              } else if (!is.na(.x) && show_labels) {
                .x
              } else if (!is.na(.y)) {
                .y
              } else {
                ""
              }
            })
          )
      },
      mapping = ggplot2::aes(x = x, y = y, label = label),
      size = 8
    ) +
    ggplot2::theme(panel.grid = ggplot2::element_blank()) +
    ggplot2::coord_fixed() +
    ggplot2::scale_fill_hue()
}

#' Easily plot euler diagrams
#'
#' @param data data
#' @param x name of main variable
#' @param y name of secondary variables
#' @param z grouping variable
#' @param seed seed
#'
#' @returns patchwork object
#' @export
#'
#' @examples
#' data.frame(
#'   A = sample(c(TRUE, TRUE, FALSE), 50, TRUE),
#'   B = sample(c("A", "C"), 50, TRUE),
#'   C = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE),
#'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
#' ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
#' mtcars |> plot_euler("vs", "am", seed = 1)
plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
  set.seed(seed = seed)
  if (!is.null(ter)) {
    ds <- split(data, data[ter])
  } else {
    ds <- list(data)
  }

  out <- lapply(ds, \(.x){
    .x[c(pri, sec)] |>
      as.data.frame() |>
      na.omit() |>
      plot_euler_single()
  })

  # names(out)
  wrap_plot_list(out)
  # patchwork::wrap_plots(out, guides = "collect")
}

#' Easily plot single euler diagrams
#'
#' @returns ggplot2 object
#' @export
#'
#' @examples
#' data.frame(
#'   A = sample(c(TRUE, TRUE, FALSE), 50, TRUE),
#'   B = sample(c("A", "C"), 50, TRUE),
#'   C = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE),
#'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
#' ) |> plot_euler_single()
#' mtcars[c("vs", "am")] |> plot_euler_single()
plot_euler_single <- function(data) {
  # if (any("categorical" %in% data_type(data))){
  #   shape <- "ellipse"
  # } else {
  #   shape <- "circle"
  # }

  data |>
    ggeulerr(shape = "circle") +
    ggplot2::theme_void() +
    ggplot2::theme(
      legend.position = "none",
      # panel.grid.major = element_blank(),
      # panel.grid.minor = element_blank(),
      # axis.text.y = element_blank(),
      # axis.title.y = element_blank(),
      text = ggplot2::element_text(size = 20),
      axis.text = ggplot2::element_blank(),
      # plot.title = element_blank(),
      # panel.background = ggplot2::element_rect(fill = "white"),
      plot.background = ggplot2::element_rect(fill = "white"),
      panel.border = ggplot2::element_blank()
    )
}