added v_venn()

NAMESPACE

@@ -62,6 +62,7 @@ export(v_specs_tooltip)
 export(v_theme)
 export(v_theme_builtin)
 export(v_treemap)
+export(v_venn)
 export(v_wordcloud)
 export(vars)
 export(vchart)
@@ -96,6 +97,7 @@ importFrom(rlang,quos)
 importFrom(rlang,set_names)
 importFrom(rlang,sym)
 importFrom(rlang,syms)
+importFrom(stats,aggregate)
 importFrom(stats,complete.cases)
 importFrom(utils,head)
 importFrom(utils,modifyList)

R/layers.R

@@ -1386,3 +1386,94 @@ v_boxplot <- function(vc,
   )
   return(vc)
 }
+
+
+
+
+#' Create a Venn Diagram
+#'
+#' @inheritParams v_bar
+#' @param sets_sep Sets separator.
+#'
+#' @return A [vchart()] `htmlwidget` object.
+#' @export
+#' 
+#' @importFrom stats aggregate
+#'
+#' @example examples/v_venn.R
+v_venn <- function(vc,
+                   mapping = NULL,
+                   data = NULL,
+                   name = NULL,
+                   sets_sep = ",",
+                   ...,
+                   serie_id = NULL,     
+                   data_id = NULL) {
+  stopifnot(
+    "\'vc\' must be a chart constructed with vchart()" = inherits(vc, "vchart")
+  )
+  data <- get_data(vc, data)
+  mapping <- get_mapping(vc, mapping)
+  mapdata <- eval_mapping_(data, mapping)
+  vc$x$type <- c(vc$x$type, "venn")
+
+  if (has_name(mapping, "category") & has_name(mapping, "values")) {
+    venndata <- as.data.frame(table(mapdata), responseName = "n")
+    venndata <- venndata[venndata$n > 0, ]
+    sets1 <- aggregate(n ~ category, data = venndata, sum)
+    names(sets1) <- c("sets", "value")
+    sets1$length <- 1
+    venndata <- data.frame(
+      sets = unname(tapply(venndata$category, venndata$values, paste, collapse = sets_sep)),
+      length = unname(tapply(venndata$category, venndata$values, length)),
+      value = unname(tapply(venndata$n, venndata$values, sum))
+    )
+    venndata <- aggregate(value ~ sets + length, data = venndata, sum)
+    venndata <- rbind(sets1, venndata[venndata$length > 1, ])
+  } else if (has_name(mapping, "sets") & has_name(mapping, "value")) {
+    venndata <- mapdata
+  }
+  serie_id <- serie_id %||% genSerieId()
+  data_id <- data_id %||% genDataId()
+  vc <- .vchart_specs(
+    vc, "data",
+    list(
+      id = data_id,
+      values = lapply(
+        X = seq_len(nrow(venndata)),
+        FUN = function(i) {
+          values <- lapply(venndata, `[`, i)
+          sets <- as.character(values$sets)
+          values$sets <- list1(unlist(strsplit(sets, split = sets_sep)))
+          return(values)
+        }
+      )
+    )
+  )
+  # vc <- v_specs(
+  #   vc = vc,
+  #   type = "venn",
+  #   # id = serie_id,
+  #   # dataId = data_id,
+  #   # name = name,
+  #   categoryField = "sets",
+  #   valueField = "value",
+  #   # seriesField = if (has_name(mapping, "colour")) "colour",
+  #   seriesField = "sets",
+  #   ...,
+  #   drop_nulls = TRUE
+  # )
+  serie <- list_(
+    type = "venn",
+    id = serie_id,
+    dataId = data_id,
+    name = name,
+    categoryField = "sets",
+    valueField = "value",
+    seriesField = if (has_name(mapping, "colour")) "colour",
+    ...
+  )
+  vc <- .vchart_specs(vc, "series", list(serie))
+  return(vc)
+}
+

R/specs.R

@@ -44,6 +44,7 @@
 #' @param serie_id Used to set or modify options for a chart where there are multiple series. You can use :
 #'   * a `numeric` to target the position of the serie in the order where it's added to the chart
 #'   * a `character` to refer to a `serie_id` set when the serie was added to the plot.
+#' @param drop_nulls Drom NULL elements from the options.
 #'
 #' @return A [vchart()] `htmlwidget` object.
 #' @export
@@ -58,28 +59,31 @@
 #'     label = list(visible = TRUE),
 #'     color = list("firebrick")
 #'   )
-v_specs <- function(vc, ..., serie_id = NULL) {
+v_specs <- function(vc, ..., serie_id = NULL, drop_nulls = FALSE) {
   stopifnot(
     "'vc' must be a 'vchart' htmlwidget object" = inherits(vc, "vchart")
   )
+  val <- list(...)
+  if (drop_nulls)
+    val <- dropNulls(val)
   if (is.null(serie_id)) {
     vc$x$specs <- modifyList(
       x = vc$x$specs,
-      val = list(...),
+      val = val,
       keep.null = TRUE
     )
   } else if (is.numeric(serie_id)) {
     vc$x$specs$series[[serie_id]] <- dropNulls(modifyList(
       x = vc$x$specs$series[[serie_id]],
-      val = list(...),
+      val = val,
       keep.null = TRUE
     ))
   } else if (is.character(serie_id)) {
     serie <- get_serie_index(vc, serie_id)
     if (length(serie) == 1) {
       vc$x$specs$series[[serie]] <- dropNulls(modifyList(
         x = vc$x$specs$series[[serie]],
-        val = list(...),
+        val = val,
         keep.null = TRUE
       ))
     }

examples/v_venn.R

@@ -0,0 +1,33 @@
+
+library(vchartr)
+
+# Venn diagram with 2 sets
+data.frame(
+  sets = c("A", "B", "A,B"),
+  value = c(5, 10, 4)
+) %>% 
+  vchart() %>% 
+  v_venn(aes(sets = sets, value = value))
+
+# with more sets 
+data.frame(
+  sets = c("A", "B", "C", "A,B", "A,C", "B,C", "A,B,C"),
+  value = c(8, 10, 12, 4, 4, 4, 2)
+) %>% 
+  vchart() %>% 
+  v_venn(aes(sets = sets, value = value))
+
+
+# More complex example
+set.seed(20190708)
+genes <- paste("gene",1:1000,sep="")
+genes <- list(
+  A = sample(genes,300), 
+  B = sample(genes,525), 
+  C = sample(genes,440),
+  D = sample(genes,350)
+)
+
+vchart(stack(genes)) %>% 
+  v_venn(aes(category = ind, values = values))
+

srcjs/widgets/vchart.js

@@ -2,6 +2,9 @@ import "widgets";
 import VChart from "@visactor/vchart";
 import { allThemeMap } from "@visactor/vchart-theme";
 
+import { registerVennChart } from '@visactor/vchart';
+registerVennChart();
+
 import * as dayjs from "dayjs";
 import utc from "dayjs/plugin/utc";
 import timezone from "dayjs/plugin/timezone";