R/Venn.R

In mbadge/vizR: Provides helper fxns for general visualization tasks

#' Create a Venn diagram to show the overlap between `l_chrs`
#'
#' @param l_chrs a list of character vectors
#' @param ... additional params to pass to \code{\link[VennDiagram]{draw.quad.venn}}
#'
#' @return nothing; outputs figure
#' @export
#' @importFrom dplyr "%>%"
#'
#' @examples
#' Venn(test_suite$l_chrs[1:4])
#' Venn(test_suite$l_chrs[1:3])
#' Venn(test_suite$l_chrs[1:2])
Venn <- function(l_chrs, ...) {
    stopifnot(len(l_chrs) %in% c(2, 3, 4))

    try(dev.off(), silent=TRUE)  # Clear graphics device if an object is there


    # Helper to compute the number of intersecting members in every single x_chr in l_chrs.
    n = function(x) {purrr::reduce(x, intersect) %>% length}

    if(length(l_chrs) == 4) {
        args <- list(area1=length(l_chrs[[1]]),
                     area2=length(l_chrs[[2]]),
                     area3=length(l_chrs[[3]]),
                     area4=length(l_chrs[[4]]),
                     n12=n(l_chrs[c(1,2)]),
                     n13=n(l_chrs[c(1,3)]),
                     n14=n(l_chrs[c(1,4)]),
                     n23=n(l_chrs[c(2,3)]),
                     n24=n(l_chrs[c(2,4)]),
                     n34=n(l_chrs[c(3,4)]),
                     n123=n(l_chrs[c(1,2,3)]),
                     n124=n(l_chrs[c(1,2,4)]),
                     n134=n(l_chrs[c(1,3,4)]),
                     n234=n(l_chrs[c(2,3,4)]),
                     n1234=n(l_chrs[c(1,2,3,4)])
        )
        if (!is.null(names(l_chrs))) {args$category = names(l_chrs)}
        args$fill = vizR::darks[1:length(l_chrs)]

        VennDiagram::draw.quad.venn %>%
            purrr::lift_dl() %>%
            purrr::invoke(args, ...)

    } else if (length(l_chrs) == 3) {
        args <- list(
            area1=length(l_chrs[[1]]),
            area2=length(l_chrs[[2]]),
            area3=length(l_chrs[[3]]),
            n12=n(l_chrs[c(1,2)]),
            n23=n(l_chrs[c(1,2)]),
            n13=n(l_chrs[c(1,2)]),
            n123=n(l_chrs[c(1,2,3)])
        )

        if (!is.null(names(l_chrs))) {args$category = names(l_chrs)}
        args$fill = vizR::darks[1:length(l_chrs)]

        VennDiagram::draw.triple.venn %>%
            purrr::lift_dl() %>%
            purrr::invoke(args, ...)

    } else if (length(l_chrs) == 2) {
        args <- list(
            area1=length(l_chrs[[1]]),
            area2=length(l_chrs[[2]]),
            cross.area=n(l_chrs[c(1, 2)])
        )
        if (!is.null(names(l_chrs))) {args$category = names(l_chrs)}
        args$fill = vizR::darks[1:length(l_chrs)]

        VennDiagram::draw.pairwise.venn %>%
            purrr::lift_dl() %>%
            purrr::invoke(args, ...)
    }
}