Merge pull request #48 from dnldelarosa/master

feat: Adds `show_set_totals` argument to display set totals
yanlinlin82 · Sep 15, 2024 · d866d13 · d866d13
2 parents 6e6380d + 205579b
commit d866d13
Show file tree

Hide file tree

Showing 16 changed files with 6,601 additions and 47 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -5,3 +5,4 @@ plots
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^\.github$
diff --git a/.github/.gitignore b/.github/.gitignore
@@ -0,0 +1 @@
+*.html
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -0,0 +1,52 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check.yaml
+
+permissions: read-all
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macos-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: ggvenn
 Title: Draw Venn Diagram by 'ggplot2'
-Version: 0.1.15
+Version: 0.1.16
 Authors@R: person(given = "Linlin", family = "Yan",
                   role = c("aut", "cre"),
                   email = "[email protected]",
@@ -22,4 +22,4 @@ Imports:
     scales,
     lifecycle
 Roxygen: list(markdown = TRUE)
-Config/testthat/edition: 3
+Config/testthat/edition: 3
diff --git a/NAMESPACE b/NAMESPACE
@@ -16,6 +16,7 @@ importFrom(dplyr,tibble)
 importFrom(dplyr,tribble)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,coord_fixed)
+importFrom(ggplot2,expansion)
 importFrom(ggplot2,geom_polygon)
 importFrom(ggplot2,geom_segment)
 importFrom(ggplot2,geom_text)
@@ -24,7 +25,9 @@ importFrom(ggplot2,guides)
 importFrom(ggplot2,layer)
 importFrom(ggplot2,scale_fill_manual)
 importFrom(ggplot2,scale_x_continuous)
+importFrom(ggplot2,scale_x_discrete)
 importFrom(ggplot2,scale_y_continuous)
+importFrom(ggplot2,scale_y_discrete)
 importFrom(ggplot2,theme_void)
 importFrom(grid,gpar)
 importFrom(grid,grobTree)

diff --git a/R/geom_venn.R b/R/geom_venn.R
@@ -6,6 +6,8 @@
 
 #' @param data A data.frame or a list as input data.
 #' @param set_names Set names, use column names if omitted.
+#' @param show_set_totals Show total count (c) and/or percentage (p) for each set.
+#' Pass a string like "cp" to show both. Any other string like "none" to hide both.
 #' @param show_stats Show count (c) and/or percentage (p) for each set. 
 #' Pass a string like "cp" to show both.
 #' @param show_percentage Show percentage for each set. Deprecated, use show_stats instead.
@@ -79,6 +81,7 @@ geom_venn <- function(mapping = NULL, data = NULL,
                       stat = "identity", position = "identity",
                       ...,
                       set_names = NULL,
+                      show_set_totals = 'none',
                       show_stats = 'cp',
                       show_percentage = deprecated(),
                       digits = 1,
@@ -114,6 +117,7 @@ geom_venn <- function(mapping = NULL, data = NULL,
       self$geom$set_names <- set_names
     }
     self$geom$customize_attributes <- list(show_stats = show_stats,
+                                           show_set_totals = show_set_totals,
                                            digits = digits,
                                            label_sep = label_sep,
                                            count_column = count_column,
@@ -150,14 +154,25 @@ GeomVenn <- ggproto("GeomVenn", Geom,
                       if ("label" %in% names(data)) {
                         show_elements <- "label"
                       }
+                      show_set_totals <- attr$show_set_totals
                       show_stats <- attr$show_stats
                       digits <- attr$digits
                       label_sep <- attr$label_sep
                       count_column <- attr$count_column
                       show_outside <- attr$show_outside
                       auto_scale <- attr$auto_scale
-                      venn <- prepare_venn_data(data, sets, show_elements, show_stats, digits,
-                                                label_sep, count_column, show_outside, auto_scale)
+                      venn <- prepare_venn_data(
+                        data, 
+                        sets, 
+                        show_elements, 
+                        show_set_totals, 
+                        show_stats, 
+                        digits,
+                        label_sep, 
+                        count_column, 
+                        show_outside, 
+                        auto_scale
+                      )
                       d0 <- coord_munch(coord, venn$shapes, panel_params)
                       d <- d0 %>%
                         filter(!duplicated(group)) %>%
@@ -179,9 +194,16 @@ GeomVenn <- ggproto("GeomVenn", Geom,
                                                         lwd = d$stroke_size * .pt,
                                                         lty = d$stroke_linetype)))
                       if (nrow(venn$labels) > 0) {
+                        #browser()
+                        .names <<- self$set_names
+                        .labels <<- venn$labels$text
+                        .new_labs <- character(length = length(.labels))
+                        for (.lab in seq_along(.labels)) {
+                          .new_labs[[.lab]] <- gsub(paste0('^', names(.names)[[.lab]]), .names[[.lab]], .labels[[.lab]])
+                        }
                         d1 <- coord_munch(coord, venn$labels, panel_params)
                         gl <- grid::gList(gl,
-                                    textGrob(self$set_names,
+                                    textGrob(.new_labs,
                                              d1$x, d1$y, default.units = "native",
                                              hjust = d1$hjust, vjust = d1$vjust,
                                              gp = gpar(col = attr$set_name_color,

diff --git a/R/ggvenn.R b/R/ggvenn.R
@@ -4,9 +4,11 @@
 #' @param data A data.frame or a list as input data.
 #' @param columns A character vector use as index to select columns/elements.
 #' @param show_elements Show set elements instead of count/percentage.
+#' @param show_set_totals Show total count (c) and/or percentage (p) for each set.
+#' Pass a string like "cp" to show both. Any other string like "none" to hide both.
 #' @param show_stats Show count (c) and/or percentage (p) for each set. 
-#' Pass a string like "cp" to show both.
 #' @param show_percentage Show percentage for each set. Deprecated, use show_stats instead.
+#' Pass a string like "cp" to show both. Any other string like "none" to hide both.
 #' @param digits The desired number of digits after the decimal point
 #' @param fill_color Filling colors in circles.
 #' @param fill_alpha Transparency for filling circles.
@@ -61,11 +63,12 @@
 #' ggvenn(d, show_elements = "value")
 #' @seealso geom_venn
 #' @importFrom dplyr tibble tribble as_tibble %>% select_if mutate count filter inner_join
-#' @importFrom ggplot2 ggplot aes geom_polygon geom_segment geom_text scale_x_continuous scale_y_continuous scale_fill_manual guides coord_fixed theme_void layer
+#' @importFrom ggplot2 ggplot aes geom_polygon geom_segment geom_text scale_x_continuous scale_y_continuous scale_fill_manual guides coord_fixed theme_void layer scale_x_discrete scale_y_discrete expansion
 #' @importFrom stats na.omit
 #' @export
 ggvenn <- function(data, columns = NULL,
                    show_elements = FALSE,
+                   show_set_totals = 'none',
                    show_stats = 'cp',
                    show_percentage = lifecycle::deprecated(),
                    digits = 1,
@@ -91,9 +94,9 @@ ggvenn <- function(data, columns = NULL,
 
     show_stats <- if (show_percentage) "cp" else "c"
   }
-  venn <- prepare_venn_data(data, columns, show_elements, show_stats, digits,
-                            label_sep, count_column, show_outside, auto_scale,
-                            comma_sep=comma_sep)
+  venn <- prepare_venn_data(data, columns, show_elements, show_set_totals, 
+                            show_stats, digits, label_sep, count_column, 
+                            show_outside, auto_scale, comma_sep=comma_sep)
   g <- venn$shapes %>%
     mutate(group = LETTERS[group]) %>%
     ggplot() +
@@ -392,7 +395,9 @@ gen_label_pos_4 <- function() {
 }
 
 prepare_venn_data <- function(data, columns = NULL,
-                              show_elements = FALSE, show_stats = "cp", digits = 1,
+                              show_elements = FALSE, 
+                              show_set_totals = '',
+                              show_stats = "cp", digits = 1,
                               label_sep = ",", count_column = NULL,
                               show_outside = c("auto", "none", "always"),
                               auto_scale = FALSE, comma_sep=FALSE) {
@@ -484,7 +489,11 @@ prepare_venn_data <- function(data, columns = NULL,
     } else {
       stop("logical columns in data.frame `data` or vector `columns` should be length between 2 and 4")
     }
-    df_label <- df_label %>% mutate(text = columns)
+    df_label <- df_label %>% 
+      mutate(
+        text = calculate_totals(data, columns, show_set_totals, digits, comma_sep),
+        hjust = 0.5
+      )
     show_elements <- !identical(show_elements, FALSE)
   } else if (is.list(data)) {
     if (is.null(columns)) {
@@ -536,7 +545,11 @@ prepare_venn_data <- function(data, columns = NULL,
     } else {
       stop("list `data` or vector `column` should be length between 2 and 4")
     }
-    df_label <- df_label %>% mutate(text = columns)
+    df_label <- df_label %>% 
+      mutate(
+        text = calculate_totals(data, columns, show_set_totals, digits, comma_sep), 
+        hjust = 0.5
+      )
   } else {
     stop("`data` should be either a list or a data.frame")
   }
@@ -580,3 +593,47 @@ prepare_venn_data <- function(data, columns = NULL,
     }
   list(shapes = df_shape, texts = df_text, labels = df_label, segs = df_seg)
 }
+
+
+# Function to calculate set totals
+calculate_totals <- function(data, columns, show_set_totals, digits, comma_sep) {
+
+  #browser()  
+
+  counts <- sapply(columns, function(column) {
+    if (inherits(data, 'data.frame')){
+      sum(data[[column]])
+    } else {
+      length(data[[column]])
+    }
+  })
+  names(counts) <- columns
+
+  total <- if (inherits(data, 'data.frame')) {
+    nrow(data)
+  } else {
+    nrow(list_to_data_frame(data))
+  }
+  percentages <- counts / total * 100
+
+  if (comma_sep) {
+    fmt_count <- "%s"
+    counts <- sapply(counts, function (.x) sprintf(fmt_count, scales::label_comma()(.x)))
+  }
+
+  if (show_set_totals == 'c') {
+    return(
+      paste0(names(counts), "\n", counts)
+    )
+  } else if (show_set_totals == 'p') {
+    return(
+      paste0(names(counts), "\n", round(percentages, digits), "%")
+    )
+  } else if (show_set_totals == 'cp') {
+    return(
+      paste0(names(counts), "\n", counts, " (", round(percentages, digits), "%)")
+    )
+  }
+
+  columns
+}
diff --git a/README.md b/README.md
@@ -2,6 +2,11 @@
 
 Venn Diagram by ggplot2, with really easy-to-use API. This package is inspired by [Venny](http://bioinfogp.cnb.csic.es/tools/venny/index.html)
 
+<!-- badges: start -->
+[![R-CMD-check](https://github.com/yanlinlin82/ggvenn/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/yanlinlin82/ggvenn/actions/workflows/R-CMD-check.yaml)
+<!-- badges: end -->
+
+
 ## Screenshots
 
 <table width="100%"><tr>

diff --git a/man/geom_venn.Rd b/man/geom_venn.Rd