#' 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 #' #' @include data_plots.R ggeulerr <- function( combinations, show_quantities = TRUE, show_labels = TRUE, ...) { ## Extracting labels labs <- sapply(names(combinations),\(.x){ # browser() get_label(combinations,.x) }) data <- ## Set labels as variable names for nicer plotting setNames(as.data.frame(combinations),labs) |> eulerr::euler(...) |> 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 = "%.4g")) # glue::glue("{.x}\n{round(.y,0)}") } 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) #' mtcars |> plot_euler("vs", "am", "cyl", seed = 1) #' stRoke::trial |> #' dplyr::mutate( #' mfi_cut = cut(mfi_6, c(0, 12, max(mfi_6, na.rm = TRUE))), #' mdi_cut = cut(mdi_6, c(0, 20, max(mdi_6, na.rm = TRUE))) #' ) |> #' purrr::map2( #' c(sapply(stRoke::trial, \(.x)REDCapCAST::get_attr(.x, attr = "label")), "Fatigue", "Depression"), #' \(.x, .y){ #' REDCapCAST::set_attr(.x, .y, "label") #' } #' ) |> #' dplyr::bind_cols() |> #' plot_euler("mfi_cut", "mdi_cut") #' stRoke::trial |> #' plot_euler(pri="male", sec=c("hypertension")) 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)] |> na.omit() |> plot_euler_single() }) wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}"))) } #' 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 = ggplot2::element_blank(), axis.title.y = ggplot2::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() ) }