Skip to content

Commit

Permalink
Allow to show set elements (#4)
Browse files Browse the repository at this point in the history
  • Loading branch information
@yanlinlin82
yanlinlin82 committed Feb 25, 2020
1 parent 7f54ded commit cfe076c
Show file tree
Hide file tree
Showing 4 changed files with 84 additions and 29 deletions.
14 changes: 12 additions & 2 deletions R/geom_venn.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,12 @@
#' geom_venn(aes(A = `Set 1`, B = `Set 2`), fill_color = c("red", "blue")) +
#' coord_fixed() +
#' theme_void()
#'
#' # show elements instead of count/percentage
#' ggplot(d) +
#' geom_venn(aes(A = `Set 1`, B = `Set 2`, C = `Set 3`, D = `Set 4`, label = value)) +
#' coord_fixed() +
#' theme_void()
#' @seealso ggvenn
#' @export
geom_venn <- function(mapping = NULL, data = NULL,
Expand Down Expand Up @@ -94,7 +100,7 @@ geom_venn <- function(mapping = NULL, data = NULL,

GeomVenn <- ggproto("GeomVenn", Geom,
required_aes = c("A", "B"),
optional_aes = c("C", "D"),
optional_aes = c("C", "D", "label"),
extra_params = c("na.rm"),
setup_data = function(self, data, params) {
data %>% mutate(xmin = -2, xmax = 2, ymin = -2, ymax = 2)
Expand All @@ -103,7 +109,11 @@ GeomVenn <- ggproto("GeomVenn", Geom,
attr <- self$customize_attributes
sets <- c("A", "B", "C", "D")
sets <- sets[sets %in% names(data)]
venn <- prepare_venn_data(data, sets)
show_elements <- NA
if ("label" %in% names(data)) {
show_elements <- "label"
}
venn <- prepare_venn_data(data, sets, show_elements)
d0 <- coord_munch(coord, venn$shapes, panel_params)
d <- d0 %>%
filter(!duplicated(group)) %>%
Expand Down
87 changes: 60 additions & 27 deletions R/ggvenn.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
#' @name ggvenn
#' @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 fill_color Filling colors in circles.
#' @param fill_alpha Transparency for filling circles.
#' @param stroke_color Stroke color for drawing circles.
Expand Down Expand Up @@ -39,9 +40,13 @@
#' # set fill color
#' ggvenn(d, c("Set 1", "Set 2"), fill_color = c("red", "blue"))
#'
#' # show elements instead of count/percentage
#' ggvenn(a, show_elements = TRUE)
#' ggvenn(d, show_elements = "value")
#' @seealso geom_venn
#' @export
ggvenn <- function(data, columns = NULL,
show_elements = FALSE,
fill_color = c("blue", "yellow", "green", "red"),
fill_alpha = .5,
stroke_color = "black",
Expand All @@ -52,7 +57,7 @@ ggvenn <- function(data, columns = NULL,
set_name_size = 6,
text_color = "black",
text_size = 4) {
venn <- prepare_venn_data(data, columns)
venn <- prepare_venn_data(data, columns, show_elements)
venn$shapes %>%
mutate(group = LETTERS[group]) %>%
ggplot() +
Expand Down Expand Up @@ -159,33 +164,48 @@ gen_label_pos_4 <- function() {
"D", 1.5, -1.3, 0, 1)
}

prepare_venn_data <- function(data, columns = NULL) {
prepare_venn_data <- function(data, columns = NULL, show_elements = FALSE) {
if (is.data.frame(data)) {
if (is.null(columns)) {
columns = data %>% select_if(is.logical) %>% names
}
if (!identical(show_elements, FALSE)) {
stopifnot(is.character(show_elements))
show_elements <- show_elements[[1]]
if (!(show_elements %in% names(data))) {
stop("`show_elements` should be one column name of the data frame")
}
}
if (length(columns) == 2) {
stopifnot(is.logical(as_tibble(data)[,columns[[1]], drop = TRUE]))
stopifnot(is.logical(as_tibble(data)[,columns[[2]], drop = TRUE]))
d <- gen_circle_2()
d1 <- gen_text_pos_2() %>% mutate(n = 0)
d1 <- gen_text_pos_2() %>% mutate(n = 0, text = "")
stopifnot((d1 %>% count(A, B) %>% with(n)) == 1)
for (i in 1:nrow(d1)) {
d1$n[[i]] <- sum((!xor(d1$A[[i]], as_tibble(data)[,columns[[1]]])) &
(!xor(d1$B[[i]], as_tibble(data)[,columns[[2]]])))
idx <- ((!xor(d1$A[[i]], as_tibble(data)[,columns[[1]]])) &
(!xor(d1$B[[i]], as_tibble(data)[,columns[[2]]])))
d1$n[[i]] <- sum(idx)
if (!identical(show_elements, FALSE)) {
d1$text[[i]] <- paste(unlist(as_tibble(data)[idx,show_elements]), collapse = ",")
}
}
d2 <- gen_label_pos_2()
} else if (length(columns) == 3) {
stopifnot(is.logical(as_tibble(data)[,columns[[1]], drop = TRUE]))
stopifnot(is.logical(as_tibble(data)[,columns[[2]], drop = TRUE]))
stopifnot(is.logical(as_tibble(data)[,columns[[3]], drop = TRUE]))
d <- gen_circle_3()
d1 <- gen_text_pos_3() %>% mutate(n = 0)
d1 <- gen_text_pos_3() %>% mutate(n = 0, text = "")
stopifnot((d1 %>% count(A, B, C) %>% with(n)) == 1)
for (i in 1:nrow(d1)) {
d1$n[[i]] <- sum((!xor(d1$A[[i]], as_tibble(data)[,columns[[1]]])) &
(!xor(d1$B[[i]], as_tibble(data)[,columns[[2]]])) &
(!xor(d1$C[[i]], as_tibble(data)[,columns[[3]]])))
idx <- ((!xor(d1$A[[i]], as_tibble(data)[,columns[[1]]])) &
(!xor(d1$B[[i]], as_tibble(data)[,columns[[2]]])) &
(!xor(d1$C[[i]], as_tibble(data)[,columns[[3]]])))
d1$n[[i]] <- sum(idx)
if (!identical(show_elements, FALSE)) {
d1$text[[i]] <- paste(unlist(as_tibble(data)[idx,show_elements]), collapse = ",")
}
}
d2 <- gen_label_pos_3()
} else if (length(columns) == 4) {
Expand All @@ -194,52 +214,63 @@ prepare_venn_data <- function(data, columns = NULL) {
stopifnot(is.logical(as_tibble(data)[,columns[[3]], drop = TRUE]))
stopifnot(is.logical(as_tibble(data)[,columns[[4]], drop = TRUE]))
d <- gen_circle_4()
d1 <- gen_text_pos_4() %>% mutate(n = 0)
d1 <- gen_text_pos_4() %>% mutate(n = 0, text = "")
stopifnot((d1 %>% count(A, B, C, D) %>% with(n)) == 1)
for (i in 1:nrow(d1)) {
d1$n[[i]] <- sum((d1$A[[i]] == as_tibble(data)[,columns[[1]], drop = TRUE]) &
(d1$B[[i]] == as_tibble(data)[,columns[[2]], drop = TRUE]) &
(d1$C[[i]] == as_tibble(data)[,columns[[3]], drop = TRUE]) &
(d1$D[[i]] == as_tibble(data)[,columns[[4]], drop = TRUE]))
idx <- ((d1$A[[i]] == as_tibble(data)[,columns[[1]], drop = TRUE]) &
(d1$B[[i]] == as_tibble(data)[,columns[[2]], drop = TRUE]) &
(d1$C[[i]] == as_tibble(data)[,columns[[3]], drop = TRUE]) &
(d1$D[[i]] == as_tibble(data)[,columns[[4]], drop = TRUE]))
d1$n[[i]] <- sum(idx)
if (!identical(show_elements, FALSE)) {
d1$text[[i]] <- paste(unlist(as_tibble(data)[idx,show_elements]), collapse = ",")
}
}
d2 <- gen_label_pos_4()
} else {
stop("logical columns in data.frame `data` or vector `columns` should be length between 2 and 4")
}
d2 <- d2 %>% mutate(text = columns)
show_elements <- !identical(show_elements, FALSE)
} else if (is.list(data)) {
if (is.null(columns)) {
columns <- names(data) %>% head(4)
}
a2 <- unique(unlist(data[columns]))
if (length(columns) == 2) {
d <- gen_circle_2()
d1 <- gen_text_pos_2() %>% mutate(n = 0)
d1 <- gen_text_pos_2() %>% mutate(n = 0, text = "")
stopifnot((d1 %>% count(A, B) %>% with(n)) == 1)
for (i in 1:nrow(d1)) {
d1$n[[i]] <- sum((!xor(d1$A[[i]], a2 %in% data[[columns[[1]]]])) &
(!xor(d1$B[[i]], a2 %in% data[[columns[[2]]]])))
idx <- ((!xor(d1$A[[i]], a2 %in% data[[columns[[1]]]])) &
(!xor(d1$B[[i]], a2 %in% data[[columns[[2]]]])))
d1$n[[i]] <- sum(idx)
d1$text[[i]] <- paste(a2[idx], collapse = ",")
}
d2 <- gen_label_pos_2()
} else if (length(columns) == 3) {
d <- gen_circle_3()
d1 <- gen_text_pos_3() %>% mutate(n = 0)
d1 <- gen_text_pos_3() %>% mutate(n = 0, text = "")
stopifnot((d1 %>% count(A, B, C) %>% with(n)) == 1)
for (i in 1:nrow(d1)) {
d1$n[[i]] <- sum((!xor(d1$A[[i]], a2 %in% data[[columns[[1]]]])) &
(!xor(d1$B[[i]], a2 %in% data[[columns[[2]]]])) &
(!xor(d1$C[[i]], a2 %in% data[[columns[[3]]]])))
idx <- ((!xor(d1$A[[i]], a2 %in% data[[columns[[1]]]])) &
(!xor(d1$B[[i]], a2 %in% data[[columns[[2]]]])) &
(!xor(d1$C[[i]], a2 %in% data[[columns[[3]]]])))
d1$n[[i]] <- sum(idx)
d1$text[[i]] <- paste(a2[idx], collapse = ",")
}
d2 <- gen_label_pos_3()
} else if (length(columns) == 4) {
d <- gen_circle_4()
d1 <- gen_text_pos_4() %>% mutate(n = 0)
d1 <- gen_text_pos_4() %>% mutate(n = 0, text = "")
stopifnot((d1 %>% count(A, B, C, D) %>% with(n)) == 1)
for (i in 1:nrow(d1)) {
d1$n[[i]] <- sum((!xor(d1$A[[i]], a2 %in% data[[columns[[1]]]])) &
(!xor(d1$B[[i]], a2 %in% data[[columns[[2]]]])) &
(!xor(d1$C[[i]], a2 %in% data[[columns[[3]]]])) &
(!xor(d1$D[[i]], a2 %in% data[[columns[[4]]]])))
idx <- ((!xor(d1$A[[i]], a2 %in% data[[columns[[1]]]])) &
(!xor(d1$B[[i]], a2 %in% data[[columns[[2]]]])) &
(!xor(d1$C[[i]], a2 %in% data[[columns[[3]]]])) &
(!xor(d1$D[[i]], a2 %in% data[[columns[[4]]]])))
d1$n[[i]] <- sum(idx)
d1$text[[i]] <- paste(a2[idx], collapse = ",")
}
d2 <- gen_label_pos_4()
} else {
Expand All @@ -249,6 +280,8 @@ prepare_venn_data <- function(data, columns = NULL) {
} else {
stop("`data` should be a list")
}
d1 <- d1 %>% mutate(text = sprintf("%d\n(%.1f%%)", n, 100 * n / sum(n)))
if (!show_elements) {
d1 <- d1 %>% mutate(text = sprintf("%d\n(%.1f%%)", n, 100 * n / sum(n)))
}
list(shapes = d, texts = d1, labels = d2)
}
6 changes: 6 additions & 0 deletions man/geom_venn.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 6 additions & 0 deletions man/ggvenn.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit cfe076c

Please sign in to comment.