R/overLapper.R

In tgirke/systemPipeR: systemPipeR: workflow management and report generation environment

##############################################
## Set Intersect and Venn Diagram Functions ##
##############################################
## Author: Thomas Girke
## Last update: Jan 5, 2015

##############################################
## Class and Method Definitions for VENNset ##
##############################################
## Define VENNset class
setClass("VENNset", representation(setlist = "list", intersectmatrix = "matrix", complexitylevels = "integer", vennlist = "list"))

## Methods to return VENNset components
setGeneric(name = "setlist", def = function(x) standardGeneric("setlist"))
setMethod(f = "setlist", signature = "VENNset", definition = function(x) {
    return(x@setlist)
})
setGeneric(name = "intersectmatrix", def = function(x) standardGeneric("intersectmatrix"))
setMethod(f = "intersectmatrix", signature = "VENNset", definition = function(x) {
    return(x@intersectmatrix)
})
setGeneric(name = "complexitylevels", def = function(x) standardGeneric("complexitylevels"))
setMethod(f = "complexitylevels", signature = "VENNset", definition = function(x) {
    return(x@complexitylevels)
})
setGeneric(name = "vennlist", def = function(x) standardGeneric("vennlist"))
setMethod(f = "vennlist", signature = "VENNset", definition = function(x) {
    return(x@vennlist)
})
setGeneric(name = "as.list", def = function(x) standardGeneric("as.list"))
setMethod(f = "as.list", signature = "VENNset", definition = function(x) {
    mylist <- list(
        setlist = x@setlist,
        intersectmatrix = x@intersectmatrix,
        complexitylevels = x@complexitylevels,
        vennlist = x@vennlist
    )
    return(mylist)
})

## Constructor methods
## List to VENNset with: as(mylist, "VENNset")
setAs(
    from = "list", to = "VENNset",
    def = function(from) {
        new("VENNset",
            setlist = from$setlist,
            intersectmatrix = from$intersectmatrix,
            complexitylevels = from$complexitylevels,
            vennlist = from$vennlist
        )
    }
)

## Define print behavior for VENNset
setMethod(
    f = "show", signature = "VENNset",
    definition = function(object) {
        cat("An instance of '", class(object), "' with ", length(object@setlist), " label sets ", "\n", sep = "")
    }
)

## Extend names() method
setMethod(
    f = "names", signature = "VENNset",
    definition = function(x) {
        return(slotNames(x))
    }
)

## Extend length() method
setMethod(
    f = "length", signature = "VENNset",
    definition = function(x) {
        return(length(x@setlist))
    }
)

###################################################
## Class and Method Definitions for INTERSECTset ##
###################################################
## Define INTERSECTset class
setClass("INTERSECTset", representation(setlist = "list", intersectmatrix = "matrix", complexitylevels = "integer", intersectlist = "list"))

## Methods to return INTERSECTset components
setMethod(f = "setlist", signature = "INTERSECTset", definition = function(x) {
    return(x@setlist)
})
setMethod(f = "intersectmatrix", signature = "INTERSECTset", definition = function(x) {
    return(x@intersectmatrix)
})
setMethod(f = "complexitylevels", signature = "INTERSECTset", definition = function(x) {
    return(x@complexitylevels)
})
setGeneric(name = "intersectlist", def = function(x) standardGeneric("intersectlist"))
setMethod(f = "intersectlist", signature = "INTERSECTset", definition = function(x) {
    return(x@intersectlist)
})
setMethod(f = "as.list", signature = "INTERSECTset", definition = function(x) {
    mylist <- list(
        setlist = x@setlist,
        intersectmatrix = x@intersectmatrix,
        complexitylevels = x@complexitylevels,
        intersectlist = x@intersectlist
    )
    return(mylist)
})

## Constructor methods
## List to INTERSECTset with: as(mylist, "INTERSECTset")
setAs(
    from = "list", to = "INTERSECTset",
    def = function(from) {
        new("INTERSECTset",
            setlist = from$setlist,
            intersectmatrix = from$intersectmatrix,
            complexitylevels = from$complexitylevels,
            intersectlist = from$intersectlist
        )
    }
)

## Define print behavior for INTERSECTset
setMethod(
    f = "show", signature = "INTERSECTset",
    definition = function(object) {
        cat("An instance of '", class(object), "' with ", length(object@setlist), " label sets and 'complexity = ", paste0(unique(object@complexitylevels), collapse = ", "), "'", "\n", sep = "")
    }
)

## Extend names() method
setMethod(
    f = "names", signature = "INTERSECTset",
    definition = function(x) {
        return(slotNames(x))
    }
)

## Extend length() method
setMethod(
    f = "length", signature = "INTERSECTset",
    definition = function(x) {
        return(length(x@setlist))
    }
)

################################
## Generic Intersect Function ##
################################
## Computation of (1) Venn Intersects and (2) Pairwise Intersects
overLapper <- function(setlist, complexity = "default", sep = "_", cleanup = FALSE, keepdups = FALSE, type) {
    ## Default complexity levels
    if (complexity[1] == "default") complexity <- 1:length(setlist)
    ## Check validity of inputs
    if (class(setlist) != "list" | length(names(setlist)) == 0) stop("Unexpected input.
             The input 'setlist' needs to be of class 'list' where each list component stores a
             label set as 'vector' and the name of each label set is provided under the
             name slot of each list component.")
    if (!all(sapply(setlist, is.vector) | sapply(setlist, is.null)) | length(setlist) < 2) stop("Unexpected input. 
	     The input 'setlist' needs to be a list with at least 2 components each 
             containig a vector of set labels.")
    if (length(type) != 1 & all(c("vennsets", "intersects") %in% type)) stop("Argument 'type' needs to be assigned 'vennsets' or 'intersects'.")
    if (type == "vennsets" & !identical(complexity, 1:length(setlist))) stop("When assigning 'vennsets' to 'type', then 'complexity' needs to be assigned 'default' or '1:length(setlist)'.")
    ## Clean up of sample sets to minimize formatting issues
    if (cleanup == TRUE) {
        ## Set all characters to upper case
        setlist <- sapply(setlist, function(x) gsub("([A-Z])", "\\U\\1", x, perl = TRUE, ignore.case = TRUE))
        ## Remove leading and trailing spaces
        setlist <- sapply(setlist, function(x) gsub("^ {1,}| {1,}$", "", x, perl = TRUE, ignore.case = TRUE))
    }
    ## Append object counter to retain duplicates
    if (keepdups == TRUE) {
        dupCount <- function(setlist = setlist) {
            count <- table(setlist)
            paste(rep(names(count), count), unlist(sapply(count, function(x) seq(1, x))), sep = ".")
        }
        mynames <- names(setlist)
        setlist <- lapply(setlist, function(x) dupCount(x)) # lapply necessary for numeric data!
        names(setlist) <- mynames
    }
    ## Create intersect matrix (removes duplicates!)
    setunion <- sort(unique(unlist(setlist)))
    setmatrix <- sapply(names(setlist), function(x) setunion %in% unique(setlist[[x]]))
    rownames(setmatrix) <- setunion
    storage.mode(setmatrix) <- "numeric"
    ## Create all possible sample combinations within requested complexity levels
    labels <- names(setlist)
    allcombl <- lapply(complexity, function(x) combn(labels, m = x, simplify = FALSE))
    allcombl <- unlist(allcombl, recursive = FALSE)
    complevels <- sapply(allcombl, length)
    ## Return intersect list for generated sample combinations
    if (type == "intersects") {
        OLlist <- sapply(seq(along = allcombl), function(x) setunion[rowSums(setmatrix[, rep(allcombl[[x]], 2)]) == 2 * length(allcombl[[x]])], simplify = FALSE)
        names(OLlist) <- sapply(allcombl, paste, collapse = sep)
        OLlist <- list(setlist = setlist, intersectmatrix = setmatrix, complexitylevels = complevels, intersectlist = OLlist)
        intersectset <- as(OLlist, "INTERSECTset")
        return(intersectset)
    }
    ## Return Venn intersect list for generated sample combinations
    if (type == "vennsets") {
        vennSets <- function(setmatrix = setmatrix, allcombl = allcombl, index = 1) {
            mycol1 <- which(colnames(setmatrix) %in% allcombl[[index]])
            mycol2 <- which(!colnames(setmatrix) %in% allcombl[[index]])
            cond1 <- rowSums(setmatrix[, rep(mycol1, 2)]) == 2 * length(mycol1)
            cond2 <- rowSums(setmatrix[, rep(mycol2, 2)]) == 0
            return(setunion[cond1 & cond2])
        }
        vennOLlist <- sapply(seq(along = allcombl), function(x) vennSets(setmatrix = setmatrix, allcombl = allcombl, index = x), simplify = FALSE)
        names(vennOLlist) <- sapply(allcombl, paste, collapse = sep)
        OLlist <- list(setlist = setlist, intersectmatrix = setmatrix, complexitylevels = complevels, vennlist = vennOLlist)
        vennset <- as(OLlist, "VENNset")
        return(vennset)
    }
}

####################################
## Venn Diagram Plotting Function ##
####################################
vennPlot <- function(x, mymain = "Venn Diagram", mysub = "default", setlabels = "default", yoffset = seq(0, 10, by = 0.34),
                     ccol = rep(1, 31), colmode = 1, lcol = c("#FF0000", "#008B00", "#0000FF", "#FF00FF", "#CD8500"),
                     lines = c("#FF0000", "#008B00", "#0000FF", "#FF00FF", "#CD8500"), mylwd = 3, diacol = 1, type = "ellipse",
                     ccex = 1.0, lcex = 1.0, sepsplit = "_", ...) {
    ## Check validity of inputs and
    if (!any(c(class(x) == "VENNset", class(x) == "list", is.numeric(x)))) {
        stop("x needs to be one of: VENNset, list of VENNsets, named numeric vector, or list of named numeric vectors.")
    }
    if (class(x) == "list") {
        if (length(unique(sapply(x, length))) != 1) stop("List components need to have identical length.")
    }
    ## Compute count set(s)
    # If x is VENNset
    if (class(x) == "VENNset") {
        counts <- list(sapply(vennlist(x), length))
        myclass <- "VENNset"
        # If x is list of VENNsets
    } else if (class(x) == "list" & all(sapply(x, class) == "VENNset")) {
        counts <- lapply(x, function(y) sapply(vennlist(y), length))
        myclass <- "VENNset"
        ## If x is count set (named numeric vector)
    } else if (is.numeric(x) & is.list(x) == FALSE) {
        counts <- list(x)
        myclass <- "numeric"
        ## If x is list of count sets
    } else if (class(x) == "list" & all(sapply(x, is.numeric))) {
        counts <- x
        myclass <- "numeric"
    } else {
        stop("x needs to be one of: VENNset, list of VENNsets, named numeric vector, or list of named numeric vectors.")
    }
    ## Check for supported number of Venn counts: 3, 7, 15 and 31
    if (!length(counts[[1]]) %in% c(3, 7, 15, 31)) stop("Only 2-5 way venn comparisons are supported.")
    ## Function to return for a set label the index of matches in the name field of a counts object
    grepLabel <- function(label, x = names(counts[[1]])) {
        x <- strsplit(x, sepsplit)
        as.numeric(which(sapply(x, function(y) any(y == label))))
    }
    ## 2-way Venn diagram
    if (length(counts[[1]]) == 3) {
        ## Define subtitle
        if (mysub == "default") {
            if (myclass == "numeric") {
                n <- names(counts[[1]])[1:2]
                if (!all(rowSums(sapply(n, function(x) sapply(n, function(y) grepl(y, x)))) == 1)) { # Checks if one or more set labels are substrings of one another
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                    if (sum(grepl(sepsplit, n)) > 0 | !all(grepl(sepsplit, names(counts[[1]][-c(1:length(n))])))) {
                        sample_counts <- rep("?", length(n))
                        warning("Set labels are substrings of one another. To fix this, the set labels need to be separated by the character provided under \"sepsplit\", but the individual names cannot contain this character themselves.")
                    }
                } else {
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grep(x, names(counts[[1]]))]))
                }
                mysub <- paste(paste("Unique objects: All =", sum(counts[[1]])), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), sep = "")
            } else if (myclass == "VENNset") {
                if (class(x) == "list") x <- x[[1]]
                sample_counts <- sapply(setlist(x), function(y) unique(length(y)))
                mysub <- paste(paste("Unique objects: All =", length(unique(unlist(setlist(x))))), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), sep = "")
            } else {
                mysub <- mysub
            }
        }
        ## Plot venn shapes
        graphics::symbols(x = c(4, 6), y = c(6, 6), circles = c(2, 2), xlim = c(0, 10), ylim = c(0, 10), inches = FALSE, main = mymain, sub = mysub, lwd = mylwd, xlab = "", ylab = "", xaxt = "n", yaxt = "n", bty = "n", fg = lines, ...)
        ## Add counts
        for (i in seq(along = counts)) {
            olDF <- data.frame(
                x = c(3.1, 7.0, 5.0),
                y = c(6.0, 6.0, 6.0),
                counts = counts[[i]]
            )
            if (colmode == 1) {
                graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol, cex = ccex, ...)
            }
            if (colmode == 2) {
                graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol[[i]], cex = ccex[i], ...)
            } # For coloring several numbers per intersect differently. ccol can needs to be list to color each field differently..
        }
        ## Add sample labels
        if (length(setlabels) == 1 & setlabels[1] == "default") {
            setlabels <- names(counts[[1]][1:2])
        } else {
            setlabels <- setlabels
        }
        graphics::text(c(2.0, 8.0), c(8.8, 8.8), labels = setlabels, col = lcol, cex = lcex, ...)
    }
    ## 3-way Venn diagram
    if (length(counts[[1]]) == 7) {
        ## Define subtitle
        if (mysub == "default") {
            if (myclass == "numeric") {
                n <- names(counts[[1]])[1:3]
                if (!all(rowSums(sapply(n, function(x) sapply(n, function(y) grepl(y, x)))) == 1)) { # Checks if one or more set labels are substrings of one another
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                    if (sum(grepl(sepsplit, n)) > 0 | !all(grepl(sepsplit, names(counts[[1]][-c(1:length(n))])))) {
                        sample_counts <- rep("?", length(n))
                        warning("Set labels are substrings of one another. To fix this, the set labels need to be separated by the character provided under \"sepsplit\", but the individual names cannot contain this character themselves.")
                    }
                } else {
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                }
                mysub <- paste(paste("Unique objects: All =", sum(counts[[1]])), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), sep = "")
            } else if (myclass == "VENNset") {
                if (class(x) == "list") x <- x[[1]]
                sample_counts <- sapply(setlist(x), function(y) unique(length(y)))
                mysub <- paste(paste("Unique objects: All =", length(unique(unlist(setlist(x))))), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), sep = "")
            } else {
                mysub <- mysub
            }
        }
        ## Plot venn shapes
        graphics::symbols(x = c(4, 6, 5), y = c(6, 6, 4), circles = c(2, 2, 2), xlim = c(0, 10), ylim = c(0, 10), inches = FALSE, main = mymain, sub = mysub, lwd = mylwd, xlab = "", ylab = "", xaxt = "n", yaxt = "n", bty = "n", fg = lines, ...)
        ## Add counts
        for (i in seq(along = counts)) {
            olDF <- data.frame(
                x = c(3.0, 7.0, 5.0, 5.0, 3.8, 6.3, 5.0),
                y = c(6.5, 6.5, 3.0, 7.0, 4.6, 4.6, 5.3),
                counts = counts[[i]]
            )
            if (colmode == 1) {
                graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol, cex = ccex, ...)
            }
            if (colmode == 2) {
                graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol[[i]], cex = ccex[i], ...)
            }
        }
        ## Add sample labels
        if (length(setlabels) == 1 & setlabels[1] == "default") {
            setlabels <- names(counts[[1]][1:3])
        } else {
            setlabels <- setlabels
        }
        graphics::text(c(2.0, 8.0, 6.0), c(8.8, 8.8, 1.1), labels = setlabels, col = lcol, cex = lcex, ...)
    }
    ## 4-way Venn diagram with ellipses
    if (length(counts[[1]]) == 15 & type == "ellipse") {
        ## Define subtitle
        if (mysub == "default") {
            if (myclass == "numeric") {
                n <- names(counts[[1]])[1:4]
                if (!all(rowSums(sapply(n, function(x) sapply(n, function(y) grepl(y, x)))) == 1)) { # Checks if one or more set labels are substrings of one another
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                    if (sum(grepl(sepsplit, n)) > 0 | !all(grepl(sepsplit, names(counts[[1]][-c(1:length(n))])))) {
                        sample_counts <- rep("?", length(n))
                        warning("Set labels are substrings of one another. To fix this, the set labels need to be separated by the character provided under \"sepsplit\", but the individual names cannot contain this character themselves.")
                    }
                } else {
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                }
                mysub <- paste(paste("Unique objects: All =", sum(counts[[1]])), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), paste("; S4 =", sample_counts[4]), sep = "")
            } else if (myclass == "VENNset") {
                if (class(x) == "list") x <- x[[1]]
                sample_counts <- sapply(setlist(x), function(y) unique(length(y)))
                mysub <- paste(paste("Unique objects: All =", length(unique(unlist(setlist(x))))), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), paste("; S4 =", sample_counts[4]), sep = "")
            } else {
                mysub <- mysub
            }
        }
        ## Plot ellipse
        plotellipse <- function(center = c(1, 1), radius = c(1, 2), rotate = 1, segments = 360, xlab = "", ylab = "", ...) {
            angles <- (0:segments) * 2 * pi / segments
            rotate <- rotate * pi / 180
            ellipse <- cbind(radius[1] * cos(angles), radius[2] * sin(angles))
            ellipse <- cbind(ellipse[, 1] * cos(rotate) + ellipse[, 2] * sin(rotate), ellipse[, 2] * cos(rotate) - ellipse[, 1] * sin(rotate))
            ellipse <- cbind(center[1] + ellipse[, 1], center[2] + ellipse[, 2])
            plot(ellipse, type = "l", xlim = c(0, 10), ylim = c(0, 10), xlab = "", ylab = "", ...)
        }
        ## Plot ellipse as 4-way venn diagram
        ellipseVenn <- function(...) {
            graphics::split.screen(c(1, 1))
            plotellipse(center = c(3.5, 3.6), radius = c(2, 4), rotate = -35, segments = 360, xlab = "", ylab = "", col = lines[1], axes = FALSE, main = mymain, sub = mysub, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(4.7, 4.4), radius = c(2, 4), rotate = -35, segments = 360, xlab = "", ylab = "", col = lines[2], axes = FALSE, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(5.3, 4.4), radius = c(2, 4), rotate = 35, segments = 360, xlab = "", ylab = "", col = lines[3], axes = FALSE, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(6.5, 3.6), radius = c(2, 4), rotate = 35, segments = 360, xlab = "", ylab = "", col = lines[4], axes = FALSE, lwd = mylwd, ...)
            ## Add counts
            for (i in seq(along = counts)) {
                olDF <- data.frame(
                    x = c(1.5, 3.5, 6.5, 8.5, 2.9, 3.1, 5.0, 5.0, 6.9, 7.1, 3.6, 5.8, 4.2, 6.4, 5.0),
                    y = c(4.8, 7.2, 7.2, 4.8, 5.9, 2.2, 0.7, 6.0, 2.2, 5.9, 4.0, 1.4, 1.4, 4.0, 2.8),
                    counts = counts[[i]]
                )
                if (colmode == 1) {
                    graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol, cex = ccex, ...)
                }
                if (colmode == 2) {
                    graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol[[i]], cex = ccex[i], ...)
                }
            }
            ## Add sample labels
            if (length(setlabels) == 1 & setlabels[1] == "default") {
                setlabels <- names(counts[[1]][1:4])
            } else {
                setlabels <- setlabels
            }
            graphics::text(c(0.4, 2.8, 7.5, 9.4), c(7.3, 8.3, 8.3, 7.3), labels = setlabels, col = lcol, cex = lcex, ...)
            graphics::close.screen(all.screens = TRUE)
        }
        ellipseVenn(...)
    }
    ## 4-way Venn diagram with circles (pseudo-venn diagram that misses two overlap sectors)
    if (length(counts[[1]]) == 15 & type == "circle") {
        ## Define subtitle
        if (mysub == "default") {
            if (myclass == "numeric") {
                n <- names(counts[[1]])[1:4]
                if (!all(rowSums(sapply(n, function(x) sapply(n, function(y) grepl(y, x)))) == 1)) { # Checks if one or more set labels are substrings of one another
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                    if (sum(grepl(sepsplit, n)) > 0 | !all(grepl(sepsplit, names(counts[[1]][-c(1:length(n))])))) {
                        sample_counts <- rep("?", length(n))
                        warning("Set labels are substrings of one another. To fix this, the set labels need to be separated by the character provided under \"sepsplit\", but the individual names cannot contain this character themselves.")
                    }
                } else {
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                }
                mysub <- paste(paste("Unique objects: All =", sum(counts[[1]])), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), paste("; S4 =", sample_counts[4]), sep = "")
            } else if (myclass == "VENNset") {
                if (class(x) == "list") x <- x[[1]]
                sample_counts <- sapply(setlist(x), function(y) unique(length(y)))
                mysub <- paste(paste("Unique objects: All =", length(unique(unlist(setlist(x))))), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), paste("; S4 =", sample_counts[4]), sep = "")
            } else {
                mysub <- mysub
            }
        }
        ## Plot venn shapes
        graphics::symbols(x = c(4, 5.5, 4, 5.5), y = c(6, 6, 4.5, 4.5), circles = c(2, 2, 2, 2), xlim = c(0, 10), ylim = c(0, 10), inches = FALSE, main = mymain, sub = mysub, lwd = mylwd, xlab = "", ylab = "", xaxt = "n", yaxt = "n", bty = "n", fg = lines, ...)
        ## Add counts
        for (i in seq(along = counts)) {
            olDF <- data.frame(
                x = c(3.0, 6.5, 3.0, 6.5, 4.8, 3.0, 4.8, 4.8, 6.5, 4.8, 3.9, 5.7, 3.9, 5.7, 4.8),
                y = c(7.2, 7.2, 3.2, 3.2, 7.2, 5.2, 0.4, 0.4, 5.2, 3.2, 6.3, 6.3, 4.2, 4.2, 5.2),
                counts = counts[[i]]
            )
            if (colmode == 1) {
                graphics::text(olDF$x[-c(7, 8)], olDF$y[-c(7, 8)] + yoffset[i], olDF$counts[-c(7, 8)], col = ccol, cex = ccex, ...)
            } # rows 14-15 of olDF are printed in next step
            if (colmode == 2) {
                graphics::text(olDF$x[-c(7, 8)], olDF$y[-c(7, 8)] + yoffset[i], olDF$counts[-c(7, 8)], col = ccol[[i]], cex = ccex[i], ...)
            }
            graphics::text(c(4.8), c(0.8) + yoffset[i], paste("Only in ", names(counts[[1]][1]), " & ", names(counts[[1]][4]), ": ", olDF$counts[7], "; Only in ", names(counts[[1]][2]), " & ", names(counts[[1]][3]), ": ", olDF$counts[8], sep = ""), col = diacol, cex = ccex, ...)
        }
        ## Add sample labels
        if (length(setlabels) == 1 & setlabels[1] == "default") {
            setlabels <- names(counts[[1]][1:4])
        } else {
            setlabels <- setlabels
        }
        graphics::text(c(2.0, 7.5, 2.0, 7.5), c(8.3, 8.3, 2.0, 2.0), labels = setlabels, col = lcol, cex = lcex, ...)
    }
    ## 5-way Venn diagram
    if (length(counts[[1]]) == 31) {
        ## Define subtitle
        if (mysub == "default") {
            if (myclass == "numeric") {
                n <- names(counts[[1]])[1:5]
                if (!all(rowSums(sapply(n, function(x) sapply(n, function(y) grepl(y, x)))) == 1)) { # Checks if one or more set labels are substrings of one another
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                    if (sum(grepl(sepsplit, n)) > 0 | !all(grepl(sepsplit, names(counts[[1]][-c(1:length(n))])))) {
                        sample_counts <- rep("?", length(n))
                        warning("Set labels are substrings of one another. To fix this, the set labels need to be separated by the character provided under \"sepsplit\", but the individual names cannot contain this character themselves.")
                    }
                } else {
                    sample_counts <- sapply(n, function(x) sum(counts[[1]][grepLabel(x, names(counts[[1]]))]))
                }
                mysub <- paste(paste("Unique objects: All =", sum(counts[[1]])), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), paste("; S4 =", sample_counts[4]), paste("; S5 =", sample_counts[5]), sep = "")
            } else if (myclass == "VENNset") {
                if (class(x) == "list") x <- x[[1]]
                sample_counts <- sapply(setlist(x), function(y) unique(length(y)))
                mysub <- paste(paste("Unique objects: All =", length(unique(unlist(setlist(x))))), paste("; S1 =", sample_counts[1]), paste("; S2 =", sample_counts[2]), paste("; S3 =", sample_counts[3]), paste("; S4 =", sample_counts[4]), paste("; S5 =", sample_counts[5]), sep = "")
            } else {
                mysub <- mysub
            }
        }
        ## Plot ellipse
        plotellipse <- function(center = c(1, 1), radius = c(1, 2), rotate = 1, segments = 360, xlab = "", ylab = "", ...) {
            angles <- (0:segments) * 2 * pi / segments
            rotate <- rotate * pi / 180
            ellipse <- cbind(radius[1] * cos(angles), radius[2] * sin(angles))
            ellipse <- cbind(ellipse[, 1] * cos(rotate) + ellipse[, 2] * sin(rotate), ellipse[, 2] * cos(rotate) - ellipse[, 1] * sin(rotate))
            ellipse <- cbind(center[1] + ellipse[, 1], center[2] + ellipse[, 2])
            plot(ellipse, type = "l", xlim = c(0, 10), ylim = c(0, 10), xlab = "", ylab = "", ...)
        }
        ## Plot ellipse as 5-way venn diagram
        ellipseVenn <- function(...) {
            graphics::split.screen(c(1, 1))
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(4.83, 6.2), radius = c(1.43, 4.11), rotate = 0, segments = 360, xlab = "", ylab = "", col = lines[1], axes = FALSE, main = mymain, sub = mysub, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(6.25, 5.4), radius = c(1.7, 3.6), rotate = 66, segments = 360, xlab = "", ylab = "", col = lines[2], axes = FALSE, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(6.1, 3.5), radius = c(1.55, 3.9), rotate = 150, segments = 360, xlab = "", ylab = "", col = lines[3], axes = FALSE, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(4.48, 3.15), radius = c(1.55, 3.92), rotate = 210, segments = 360, xlab = "", ylab = "", col = lines[4], axes = FALSE, lwd = mylwd, ...)
            graphics::screen(1, new = FALSE)
            plotellipse(center = c(3.7, 4.8), radius = c(1.7, 3.6), rotate = 293.5, segments = 360, xlab = "", ylab = "", col = lines[5], axes = FALSE, lwd = mylwd, ...)
            ## Add counts
            for (i in seq(along = counts)) {
                olDF <- data.frame(
                    x = c(4.85, 8.0, 7.1, 3.5, 2.0, 5.90, 4.4, 4.60, 3.60, 7.1, 6.5, 3.2, 5.4, 6.65, 3.40, 5.00, 6.02, 3.60, 5.20, 4.03, 4.20, 6.45, 6.8, 3.39, 6.03, 5.74, 4.15, 3.95, 5.2, 6.40, 5.1),
                    y = c(8.30, 6.2, 1.9, 1.6, 5.4, 6.85, 6.6, 2.45, 6.40, 4.3, 6.0, 4.6, 2.1, 3.40, 3.25, 6.43, 6.38, 5.10, 2.49, 6.25, 3.08, 5.30, 4.0, 3.80, 3.20, 5.95, 5.75, 3.75, 3.0, 4.50, 4.6),
                    counts = counts[[i]]
                )
                if (colmode == 1) {
                    graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol, cex = ccex, ...)
                }
                if (colmode == 2) {
                    graphics::text(olDF$x, olDF$y + yoffset[i], olDF$counts, col = ccol[[i]], cex = ccex[i], ...)
                }
            }
            ## Add sample labels
            if (length(setlabels) == 1 & setlabels[1] == "default") {
                setlabels <- names(counts[[1]][1:5])
            } else {
                setlabels <- setlabels
            }
            graphics::text(c(5.7, 7.9, 8.5, 4.2, 0.8), c(9.9, 7.9, 1.9, 0.0, 7.3), adj = c(0, 0.5), labels = setlabels, col = lcol, cex = lcex, ...)
            graphics::close.screen(all.screens = TRUE)
        }
        ellipseVenn(...)
    }
}

##########################################
## Bar Plot Function for Intersect Sets ##
##########################################
## Plots the counts of VENNset/INTERSECTset generated by overLapper function
olBarplot <- function(x, mincount = 0, complexity = "default", myxlabel = "default", myylabel = "Counts", mytitle = "default", ...) {
    ## Check validity of inputs
    if (!any(c("VENNset", "INTERSECTset") %in% class(x))) stop("x needs to be of class VENNset or INTERSECTset")
    ## global functions or variables
    Intersect_Sets <- Counts <- Level <- NULL
    ## Generate counts
    if (class(x) == "VENNset") counts <- sapply(vennlist(x), length)
    if (class(x) == "INTERSECTset") counts <- sapply(intersectlist(x), length)
    ## Complexity filter
    if (complexity[1] != "default") {
        complfilter <- complexitylevels(x) %in% complexity
    } else {
        complfilter <- complexitylevels(x) %in% complexitylevels(x)
    }
    ## Min count filter
    mincountfilter <- counts >= mincount
    ## Apply filters
    myfilter <- complfilter & mincountfilter
    counts <- counts[myfilter]
    ## Color bars by default by complexity levels
    mycol <- complexitylevels(x)
    mycol <- mycol[myfilter]
    ## Define x-axis label
    if (myxlabel == "default") {
        myxlabel <- paste("Intersect Sets (min count cutoff = ", mincount, ")", sep = "")
    } else {
        myxlabel <- myxlabel
    }
    ## Define main title
    if (mytitle == "default") {
        mytitle <- paste("Intersect Plot of", class(x), "Object")
    } else {
        mytitle < mytitle
    }
    ## Generate bar plot with ggplot2
    df_plot <- data.frame(Intersect_Sets = names(counts), Counts = counts, Level = as.character(mycol))
    df_plot[, 1] <- factor(df_plot[, 1], levels = unique(df_plot[, 1]), ordered = TRUE) # Defines plotting order of bars!!!
    ggplot2::ggplot(df_plot, ggplot2::aes(Intersect_Sets, Counts, fill = Level)) +
        ggplot2::geom_bar(position = "stack", stat = "identity", ...) +
        ggplot2::coord_flip() +
        ggplot2::theme(legend.position = "none") +
        ggplot2::theme(axis.text.y = ggplot2::element_text(angle = 0, hjust = 1)) +
        ggplot2::labs(x = myxlabel, y = myylabel) +
        ggplot2::ggtitle(mytitle)
}