├── .Rbuildignore ├── R ├── sysdata.rda ├── utils.R ├── checkZone.R ├── getCentroid.R ├── openPlot.R ├── extractInfo.R ├── extractDisjunctions.R ├── getZones.R └── plotRules.R ├── .gitignore ├── man ├── venn_internal.Rd ├── venn_package.Rd ├── extractInfo.Rd ├── getCentroid.Rd ├── getZones.Rd ├── venn.Rd └── figures │ ├── fig01.svg │ ├── fig05.svg │ ├── fig03.svg │ ├── fig06.svg │ ├── fig18.svg │ ├── fig08.svg │ └── fig02.svg ├── NAMESPACE ├── DESCRIPTION ├── .github └── FUNDING.yml ├── inst └── ChangeLog └── README.md /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | man/figures/ 4 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dusadrian/venn/HEAD/R/sysdata.rda -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.js~ 2 | *.marks 3 | *.history 4 | *.o 5 | *.so 6 | *.Rproj.user 7 | *.Rhistory 8 | *.RData 9 | *.Ruserdata 10 | *.DS_Store 11 | .Rproj.user 12 | venn.Rproj 13 | -------------------------------------------------------------------------------- /man/venn_internal.Rd: -------------------------------------------------------------------------------- 1 | \name{venn internal functions} 2 | 3 | \alias{checkZone} 4 | \alias{openPlot} 5 | \alias{translate2} 6 | \alias{plotRules} 7 | \alias{getBorders} 8 | \alias{getIB} 9 | \alias{getICoords} 10 | \alias{getSCoords} 11 | \alias{getInts} 12 | \alias{getSets} 13 | 14 | 15 | \title{Internal Functions} 16 | 17 | \description{ 18 | The above functions are internal in the venn package, 19 | which are not designed to be called directly by the user. 20 | } 21 | 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | export(checkZone, 2 | extractInfo, 3 | getBorders, 4 | getCentroid, 5 | getIB, 6 | getICoords, 7 | getSCoords, 8 | getInts, 9 | getSets, 10 | getZones, 11 | openPlot, 12 | plotRules, 13 | venn) 14 | import(admisc) 15 | importFrom("grDevices", "adjustcolor", "col2rgb", "colorRampPalette", "dev.cur", 16 | "dev.new", "rgb") 17 | importFrom("graphics", "lines", "par", "plot", "polygon", "polypath", "text", 18 | "points", "title") 19 | importFrom("utils", "tail", "packageDescription", "read.csv", "capture.output") 20 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: venn 2 | Version: 1.12.2 3 | Title: Draw Venn Diagrams 4 | Authors@R: person(given = "Adrian", family = "Dusa", 5 | role = c("aut", "cre", "cph"), 6 | email = "dusa.adrian@unibuc.ro", 7 | comment = c(ORCID = "0000-0002-3525-9253")) 8 | Depends: R (>= 3.5.0) 9 | Imports: admisc (>= 0.33) 10 | Suggests: QCA (>= 3.9), ggplot2, ggpolypath 11 | Description: A close to zero dependency package to draw and display Venn 12 | diagrams up to 7 sets, and any Boolean union of set intersections. 13 | License: GPL (>= 3) 14 | URL: https://github.com/dusadrian/venn 15 | BugReports: https://github.com/dusadrian/venn/issues 16 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [dusadrian] 4 | patreon: dusadrian 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: dusadrian 10 | issuehunt: # Replace with a single IssueHunt username 11 | lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry 12 | polar: # Replace with a single Polar username 13 | buy_me_a_coffee: dusadrian 14 | thanks_dev: # Replace with a single thanks.dev username 15 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 16 | -------------------------------------------------------------------------------- /man/venn_package.Rd: -------------------------------------------------------------------------------- 1 | \name{About the venn package} 2 | 3 | \alias{venn-package} 4 | 5 | \docType{package} 6 | 7 | \title{ 8 | Draw Venn Diagrams 9 | } 10 | 11 | \description{ 12 | A close to zero dependency package to draw and display Venn diagrams, and any 13 | boolean union of set intersections. 14 | } 15 | 16 | \details{ 17 | \tabular{ll}{ 18 | Package: \tab venn\cr 19 | Type: \tab Package\cr 20 | Version: \tab 1.12.2\cr 21 | Date: \tab 2024-10-06\cr 22 | License: \tab GPL (>= 2)\cr 23 | } 24 | } 25 | 26 | \author{ 27 | 28 | \bold{Authors}:\cr 29 | Adrian Dusa\cr 30 | Department of Sociology\cr 31 | University of Bucharest\cr 32 | \email{dusa.adrian@unibuc.ro} 33 | 34 | \bold{Maintainer}:\cr 35 | Adrian Dusa 36 | } 37 | 38 | 39 | \keyword{package} 40 | -------------------------------------------------------------------------------- /man/extractInfo.Rd: -------------------------------------------------------------------------------- 1 | \name{extractInfo} 2 | 3 | \alias{extractInfo} 4 | 5 | \title{Extract information about a list object.} 6 | 7 | \description{ 8 | Extracts useful information such as the counts or the actual intersections 9 | between several sets. 10 | } 11 | 12 | \usage{ 13 | extractInfo( 14 | x, what = c("counts", "intersections", "both"), use.names = FALSE 15 | ) 16 | } 17 | 18 | \arguments{ 19 | \item{x}{A list object containing set elements, or a list of binary values} 20 | \item{what}{What to extract} 21 | \item{use.names}{Logical, use the set names to indicate intersections} 22 | } 23 | 24 | \details{ 25 | When the argument \bold{\code{x}} is a list, the counts are taken from the number 26 | of common values for each intersection, and when \bold{\code{x}} is a dataframe, 27 | (comprised of exclusively binary values 0 and 1) the counts are taken from the 28 | number of similar rows. 29 | } 30 | 31 | 32 | \value{ 33 | A dataframe, when extracting the counts or a list if extracting intersections. 34 | } 35 | 36 | \examples{ 37 | 38 | set.seed(12345) 39 | xlist <- list(A = 1:20, B = 10:30, C = sample(25:50, 15)) 40 | xdf <- as.data.frame(matrix( 41 | sample(0:1, 90, replace = TRUE), 42 | ncol = 3 43 | )) 44 | colnames(xdf) <- LETTERS[1:3] 45 | 46 | extractInfo(xlist) # counts by default 47 | 48 | extractInfo(xlist, what = "intersections") 49 | 50 | extractInfo(xlist, what = "both") 51 | 52 | extractInfo(xdf) 53 | 54 | } 55 | 56 | 57 | \keyword{functions} 58 | -------------------------------------------------------------------------------- /man/getCentroid.Rd: -------------------------------------------------------------------------------- 1 | \name{getCentroid} 2 | 3 | \alias{getCentroid} 4 | 5 | \title{Calculate the centroid of a polygon.} 6 | 7 | \description{ 8 | This function takes a list of dataframes or a matrices containing x and y values, 9 | which define zones (polygons), and calculates their centroids. 10 | } 11 | 12 | \usage{ 13 | getCentroid(data) 14 | } 15 | 16 | \arguments{ 17 | \item{data}{A matrix or a dataframe with two columns, for x and y coordinates} 18 | } 19 | 20 | \details{ 21 | 22 | Most of the coordinates for the intersection labels in this package were calculated using 23 | the formula for a centroid of a non-self-intersecting closed polygon, approximated by 10 24 | vertices. 25 | 26 | } 27 | 28 | 29 | \value{ 30 | 31 | A list with x and y coordinates, for each zone in the input list. 32 | 33 | } 34 | 35 | 36 | \references{ 37 | 38 | Centroid. (n.d.). In Wikipedia. Retrieved January 06, 2016, from 39 | https://en.wikipedia.org/wiki/Centroid 40 | 41 | } 42 | 43 | \examples{ 44 | 45 | venn("0110") 46 | 47 | # centroid for the intersection "0110" in a 4 set diagram 48 | centroid <- getCentroid(getZones("0110"))[[1]] 49 | 50 | text(centroid[1], centroid[2], labels = "0110", cex = 0.85) 51 | 52 | 53 | # centroids for the two zones in the "E not A" zones 54 | venn(5) 55 | area <- getZones("0---1") # list of length 2 56 | 57 | polygon(area[[1]], col="lightblue") 58 | 59 | polygon(area[[2]], col="lightblue") 60 | 61 | text(do.call("rbind", getCentroid(area)), 62 | labels = c("zone 1", "zone 2"), cex = 0.85) 63 | 64 | } 65 | 66 | 67 | \keyword{functions} 68 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `getBorders` <- function() return(borders) 32 | `getIB` <- function() return(ib) 33 | `getICoords` <- function() return(icoords) 34 | `getSCoords` <- function() return(scoords) 35 | `getInts` <- function() return(ints) 36 | `getSets` <- function() return(sets) 37 | -------------------------------------------------------------------------------- /man/getZones.Rd: -------------------------------------------------------------------------------- 1 | \name{getZones} 2 | 3 | \alias{getZones} 4 | 5 | \title{Calculate the union(s) of set intersections.} 6 | 7 | \description{ 8 | This function uses a metacommand to calculate the shape of a specific 9 | zone or a list of zones. 10 | } 11 | 12 | \usage{ 13 | getZones(area, snames, ellipse = FALSE) 14 | } 15 | 16 | \arguments{ 17 | \item{area}{A character expression written in sum of products form.} 18 | \item{snames}{A string containing the sets' names, separated by commas.} 19 | \item{ellipse}{Logical, get the zones from the shape of an ellipse, where possible} 20 | } 21 | 22 | \details{ 23 | 24 | A SOP ("sum of products") is also known as a DNF ("disjunctive normal form"), or in other 25 | words a "union of intersections", for example \bold{\code{A*D + B*c}}. 26 | 27 | The same expression can be written in curly brackets notation: 28 | \bold{\code{A{1}*D{1} + B{1}*C{0}}}. 29 | 30 | 31 | The expression \bold{\code{B{1}*C{0}}} can also be written in a pseudo-language, as 32 | "-10-" (assuming there are only four sets). 33 | 34 | 35 | A "zone" is a union of set intersections. There are exactly \bold{\code{2^k}} intersections 36 | in a Venn diagram, where \bold{\code{k}} is the number of sets. To highlight an entire set, 37 | we need a union of all possible intersections which form that set. 38 | 39 | 40 | The argument \bold{\code{ellipse}} retrieves the data from the shape of an ellipse, and it only 41 | works with 4 and 5 sets. 42 | 43 | } 44 | 45 | 46 | \value{ 47 | A list of self-enclosed polygons, for each independent zone. 48 | } 49 | 50 | \examples{ 51 | 52 | venn(3) 53 | 54 | area <- getZones("A", snames = "A, B, C") 55 | # a list of length 1 56 | 57 | polygon(area[[1]], col="lightblue") 58 | 59 | 60 | # The very same result is obtained with: 61 | zone <- getZones("1--") 62 | 63 | 64 | 65 | # for 5 sets, the content of the 5th set but not in the first set is a 66 | # list of two zones 67 | 68 | venn(5) 69 | 70 | zones <- getZones("0---1") 71 | # this time a list of length 2 72 | 73 | # (re)coloring the first zone (union) 74 | polygon(zones[[1]], col="lightblue") 75 | 76 | # and the second zone (union) 77 | polygon(zones[[2]], col="lightblue") 78 | 79 | } 80 | 81 | 82 | \keyword{functions} 83 | -------------------------------------------------------------------------------- /R/checkZone.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `checkZone` <- function(from, zones, checkz, nofsets, ib, ellipse) { 32 | fromz <- ib[ib$s == nofsets & ib$v == as.numeric(ellipse) & ib$i == from, ] 33 | toz <- ib[ib$s == nofsets & ib$v == as.numeric(ellipse) & ib$i %in% zones[!checkz], ] 34 | toz <- toz[toz$b %in% fromz$b, , drop = FALSE] 35 | 36 | if (nrow(toz) > 0) { 37 | zs <- sort(unique(toz$i)) 38 | 39 | checkz[as.character(zs)] <- TRUE 40 | for (i in zs) { 41 | checkz <- checkz | Recall(i, zones, checkz, nofsets, ib, ellipse) 42 | } 43 | } 44 | 45 | return(checkz) 46 | } 47 | 48 | -------------------------------------------------------------------------------- /R/getCentroid.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `getCentroid` <- 32 | function(data) { 33 | return(lapply(data, function(x) { 34 | if (all(is.na(x[nrow(x), ]))) { 35 | x <- x[-nrow(x), ] 36 | } 37 | 38 | if (nrow(x) > 10) { 39 | vals <- seq(1, nrow(x), by = floor(nrow(x)/10)) 40 | x <- x[c(vals, nrow(x)), ] 41 | } 42 | 43 | asum <- cxsum <- cysum <- 0 44 | 45 | for (i in seq(2, nrow(x))) { 46 | asum <- asum + x$x[i - 1]*x$y[i] - x$x[i]*x$y[i - 1] 47 | cxsum <- cxsum + (x$x[i - 1] + x$x[i])*(x$x[i - 1]*x$y[i] - x$x[i]*x$y[i - 1]) 48 | cysum <- cysum + (x$y[i - 1] + x$y[i])*(x$x[i - 1]*x$y[i] - x$x[i]*x$y[i - 1]) 49 | } 50 | 51 | return(c((1/(3*asum))*cxsum, (1/(3*asum))*cysum)) 52 | })) 53 | } 54 | 55 | 56 | -------------------------------------------------------------------------------- /R/openPlot.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `openPlot` <- function(plotsize = 15, par = TRUE, ggplot = FALSE, ...) { 32 | 33 | if (ggplot) { 34 | cf <- ggplot2::coord_fixed() 35 | cf$default <- TRUE 36 | return(ggplot2::ggplot() + ggplot2::geom_blank() + 37 | cf + 38 | ggplot2::coord_fixed(xlim = c(0, 1000), ylim = c(0, 1000)) + 39 | ggplot2::theme(axis.line = ggplot2::element_blank(), 40 | axis.text.x = ggplot2::element_blank(), 41 | axis.text.y = ggplot2::element_blank(), 42 | axis.ticks = ggplot2::element_blank(), 43 | axis.title.x = ggplot2::element_blank(), 44 | axis.title.y = ggplot2::element_blank(), 45 | legend.position = "none", 46 | panel.background = ggplot2::element_blank(), 47 | panel.border = ggplot2::element_blank(), 48 | panel.grid.major = ggplot2::element_blank(), 49 | panel.grid.minor = ggplot2::element_blank(), 50 | plot.background = ggplot2::element_blank(), 51 | axis.ticks.length.x = ggplot2::unit(.25, "cm"), 52 | axis.ticks.length.y = ggplot2::unit(.25, "cm"), 53 | plot.title = ggplot2::element_text(size = 0), 54 | plot.subtitle = ggplot2::element_text(size = 0), 55 | plot.tag = ggplot2::element_text(size = 0), 56 | plot.caption = ggplot2::element_text(size = 0))) 57 | } 58 | else { 59 | if (par) { 60 | if (dev.cur() == 1) { 61 | dev.new(width = (plotsize + 1)/2.54, height = (plotsize + 1)/2.54) 62 | } 63 | 64 | par(new = FALSE, xpd = TRUE, mai = c(0.05, 0.05, 0.05, 0.05)) 65 | } 66 | 67 | dots <- list(...) 68 | plot(x = 0:1000, type = "n", axes = FALSE, asp = 1, xlab = "", ylab = "") 69 | 70 | if (!is.null(dots$main)) { 71 | title(main = dots$main, line = ifelse(is.null(dots$line), -1, dots$line)) 72 | } 73 | } 74 | } 75 | -------------------------------------------------------------------------------- /inst/ChangeLog: -------------------------------------------------------------------------------- 1 | Version 1.13 2 | o Bug fix displaying disjunctive expressions (thanks to Mostapha Ashour for 3 | the report) 4 | 5 | Version 1.12 6 | o New function extractInfo(), to allow extracting the counts or the actual 7 | intersections between several sets, prior to drawing the diagram 8 | (thanks to Mehrad Mahmoudian for the suggestion) 9 | o An error is generated if the input is a QCA truth table with more than 10 | seven explanatory conditions (thanks to Leo Gurtler for the report) 11 | 12 | Version 1.11 13 | o Solved bug related plotting counts for QCA objects 14 | (thanks to yanbinghan for the report) 15 | o Argument "counts" is now deprecated, the same information can be passed to 16 | the argument "ilabels" 17 | o Some more graphical parameters are possible to be passed via the three 18 | dots ... argument 19 | 20 | Version 1.10 21 | o Solved bug related to fill colors with ggplot graphics 22 | (thanks to Dan Chaltiel for the report) 23 | o Package venn now depends on R >= 3.5.0 24 | 25 | Version 1.9 26 | o Better handling of internal data, possibly solving rare bugs when 27 | installing in non-standard, custom directories 28 | o Argument "size" from function venn() renamed to "plotsize", as the former 29 | is a formal argument for the ggplot2 function geom_path() 30 | o Added flexibility when using additional aesthetic ggplot parameters 31 | 32 | Version 1.8 33 | o New arguments "box", "par" and "ggplot" to function venn() 34 | (thanks to Mehrad Mahmoudian for the suggestion) 35 | o Arguments "cexil" and "cexsn" in function venn() 36 | renamed to "ilcs" and "sncs" 37 | o Function venn() now accepts set names containing spaces 38 | (thanks to Andre Gohr for the suggestion) 39 | 40 | Version 1.7 41 | o Bug fix, when the input in the venn() function is a QCA solution. 42 | o Argument "counts" in function venn() is now used as a numerical vector for 43 | the set intersections (thanks to William Robbins for the suggestion) 44 | 45 | Version 1.6 46 | o Major change in the treatment of custom intersections, the package 47 | now supports set unions (using the plus sign), as well as set intersections. 48 | Multiple intersections / expressions are now separated with a comma. 49 | o New argument "borders" to function venn(), defaulted to TRUE in order to 50 | preserve backwards compatibility. When deactivated, only the custom 51 | intersections will be plotted. 52 | 53 | Version 1.5 54 | o Adapted to package QCA version 3.0 55 | o Replaced the argument "nofsets" with "snames", in function getZones() 56 | o Argument "transparency" renamed to "opacity" 57 | o Arguments "zcolor" and "col" in function venn() now accept a single 58 | character expression, as well as a character vector to specify colors 59 | o Removed suggestion to package QCAGUI, which is now merged into package QCA 60 | o Argument cexil in function venn() is now defaulted to 0.6, with an 61 | automatic change to 0.5 for six sets and 0.45 for seven sets 62 | o When the input is a list, invisibly return the truth table and the counts 63 | for each intersection, with an attribute called "intersections" containing 64 | its elements (thanks to Jeena Ganga for the suggestion) 65 | 66 | Version 1.2 67 | o Adaptation to package QCA version 2.2 68 | o Fixed a bug when interpreting a SOP expression, the negation of a set 69 | was interpreted as the set itself 70 | o When the expression is a valid R statement, quoting is not necessary 71 | anymore 72 | 73 | Version 1.1 74 | o Fixed minor bugs 75 | o New feature to draw a Venn diagram using a SOP (sum of products) expression 76 | o QCA type objects can have transparency based on the inclusion score 77 | o Parameters for borders can have lengths, recycled to the length of zones 78 | 79 | The following were all suggested by Tom Wenseleers (with thanks): 80 | 81 | o The plot window is now forced to a square, using asp = 1 82 | o New shapes for 4 and 5 sets, to maximize the space for intersections 83 | o Default color styles, and associated border colors 84 | o Variable text size for the intersection labels and for the set names 85 | 86 | 87 | Version 1.0 88 | o First version of the package 89 | -------------------------------------------------------------------------------- /R/extractInfo.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `extractInfo` <- function( 32 | x, what = c("counts", "intersections", "both"), use.names = FALSE 33 | ) { 34 | 35 | what <- match.arg(what) 36 | 37 | if (!is.list(x)) { 38 | admisc::stopError("Argument x should be a data frame or a list") 39 | } 40 | 41 | if (is.data.frame(x)) { 42 | nofsets <- ncol(x) 43 | if (nofsets > 7) { 44 | x <- x[, 1:7] 45 | nofsets <- 7 46 | } 47 | what <- "counts" 48 | if (!identical(names(table(unlist(x))), c("0", "1"))) { 49 | admisc::stopError("Values in x should only be 0s and 1s") 50 | } 51 | } 52 | else { 53 | nofsets <- length(x) 54 | if (nofsets > 7) { 55 | x <- x[seq(7)] 56 | nofsets <- 7 57 | } 58 | } 59 | 60 | 61 | if (any(names(x) == "")) { 62 | names(x) <- LETTERS[seq(nofsets)] 63 | } 64 | 65 | snames <- names(x) 66 | 67 | tt <- sapply( 68 | rev(seq(nofsets)), 69 | function(x) { 70 | rep.int( 71 | c(sapply(0:1, function(y) rep.int(y, 2^(x - 1)))), 72 | 2^nofsets / 2^x 73 | ) 74 | } 75 | ) 76 | 77 | 78 | colnames(tt) <- snames 79 | 80 | if (!isTRUE(use.names)) { 81 | snames <- seq(length(snames)) 82 | } 83 | 84 | rownames(tt) <- apply( 85 | tt, 86 | 1, 87 | function(x) paste(snames[x == 1], collapse = ":") 88 | ) 89 | 90 | if (is.data.frame(x)) { 91 | powers <- 2^seq(nofsets - 1, 0) 92 | tbl <- table(apply(x, 1, function(r) return(sum(r * powers) + 1))) 93 | ttcts <- rep(0, 2^nofsets) 94 | ttcts[as.numeric(names(tbl))] <- as.vector(tbl) 95 | } 96 | else { 97 | intersections <- apply(tt, 1, 98 | function(y) { 99 | setdiff(Reduce(intersect, x[y == 1]), unlist(x[y == 0])) 100 | } 101 | ) 102 | 103 | names(intersections) <- rownames(tt) 104 | 105 | ttcts <- unlist(lapply(intersections, length)) 106 | 107 | intersections <- intersections[ttcts > 0] 108 | } 109 | 110 | 111 | tt <- as.data.frame(cbind(tt, counts = ttcts)) 112 | 113 | if (what == "counts") { 114 | return(tt) 115 | } 116 | 117 | if (what == "intersections") { 118 | return(intersections) 119 | } 120 | 121 | return(list(tt, intersections)) 122 | } 123 | -------------------------------------------------------------------------------- /R/extractDisjunctions.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `extractDisjunctions` <- function(x, snames) { 32 | 33 | # purpose: allow complete disjunctions to be plotted 34 | # in version 1.5, something like "A + (B + C)" is treated as "A + B + C" 35 | if (missing(snames)) { 36 | snames <- "" 37 | } 38 | 39 | if (nchar(gsub("[A-Za-z]|\\+|\\*|\\(|\\)| |~", "", x)) > 0) { 40 | admisc::stopError("Invalid expression.") 41 | } 42 | 43 | transformx <- function(x) { 44 | unname(apply(x, 1, function(x) { 45 | x[x < 0] <- "-" 46 | paste(x, collapse = "") 47 | })) 48 | } 49 | 50 | y <- admisc::translate(x, snames = snames) 51 | snames <- colnames(y) 52 | 53 | if (grepl("\\(|\\)", x)) { 54 | opened <- gsub("[A-Za-z]|\\+|\\*|\\(", "", x) 55 | closed <- gsub("[A-Za-z]|\\+|\\*|\\)", "", x) 56 | if (nchar(opened) != nchar(closed)) { 57 | cat("\n") 58 | stop(simpleError("All opened / closed brackets should match.\n\n")) 59 | } 60 | 61 | if (grepl("\\)\\*\\(|\\)\\(", x)) { 62 | cat("\n") 63 | stop(simpleError("Brackets are allowed only for disjunctions.\n\n")) 64 | } 65 | 66 | sx <- unlist(strsplit(x, split = "")) 67 | wf <- which(sx == "(")[1] 68 | if (wf != 1) { 69 | if (sx[wf - 1] != "+") { 70 | cat("\n") 71 | stop(simpleError("Brackets are allowed only for disjunctions.\n\n")) 72 | } 73 | } 74 | 75 | x <- unlist(strsplit(x, split = "")) 76 | opened <- which(x == "(") 77 | closed <- which(x == ")") 78 | 79 | if (opened[1] == 1) { 80 | if (closed[length(closed)] != length(x)) { 81 | cat("\n") 82 | stop(simpleError("Invalid expression.\n\n")) 83 | } 84 | else { 85 | x <- x[-c(1, length(x))] 86 | opened <- opened[-1] 87 | closed <- closed[-length(closed)] 88 | } 89 | } 90 | 91 | if (length(opened) > 0) { 92 | 93 | if (opened[1] == 1) { 94 | cat("\n") 95 | stop(simpleError("Invalid expression.\n\n")) 96 | } 97 | 98 | result <- list(transformx(admisc::translate(paste(x[seq(1, opened[1] - 1)], collapse = ""), snames = snames))) 99 | for (i in seq(length(opened))) { 100 | result[[i + 1]] <- transformx(admisc::translate(paste(x[seq(opened[i] + 1, closed[i] - 1)], collapse = ""), snames = snames)) 101 | } 102 | if (closed[length(closed)] != length(x)) { 103 | if (x[closed[length(closed)] + 1] != "+") { 104 | cat("\n") 105 | stop(simpleError("Brackets are allowed only for disjunctions.\n\n")) 106 | } 107 | 108 | result[[length(result) + 1]] <- transformx(admisc::translate(paste(x[seq(closed[length(closed)] + 2, length(x))], collapse = ""), snames = snames)) 109 | } 110 | 111 | return(result) 112 | } 113 | else { 114 | return(list(transformx(y))) 115 | } 116 | } 117 | else { 118 | return(list(transformx(y))) 119 | } 120 | 121 | } 122 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Package venn 2 | 3 | This package produces Venn diagrams for up to seven sets, using any Boolean union of set intersections. 4 | 5 | 6 | Installation 7 | ------------ 8 | 9 | Install the stable version from CRAN: 10 | ``` r 11 | install.packages("venn") 12 | ``` 13 | 14 | Examples 15 | -------- 16 | 17 | A simple Venn diagram with 3 sets 18 | ``` r 19 | venn(3) 20 | ``` 21 | 22 | 23 | 24 | 25 | With a vector of counts: 1 for "000", 2 for "001" etc. 26 | ``` r 27 | venn(3, counts = 1:8) 28 | ``` 29 | 30 | 31 | 32 | 33 | Display the first whole set 34 | ``` r 35 | venn("1--") 36 | ``` 37 | 38 | 39 | 40 | 41 | Same with 42 | ``` r 43 | venn("A", snames = "A, B, C") 44 | ``` 45 | 46 | 47 | 48 | 49 | An equivalent command, from the union of all intersections 50 | ``` r 51 | venn("100 + 110 + 101 + 111") 52 | ``` 53 | 54 | 55 | 56 | 57 | Same with 58 | ``` r 59 | venn("A~B~C + AB~C + A~BC + ABC") 60 | ``` 61 | 62 | 63 | 64 | 65 | Adding the labels for the intersections 66 | ``` r 67 | venn("1--", ilabels = TRUE) 68 | ``` 69 | 70 | 71 | 72 | 73 | Using different parameters for the borders 74 | ``` r 75 | venn(4, lty = 5, col = "navyblue") 76 | ``` 77 | 78 | 79 | 80 | 81 | Using ellipses 82 | ``` r 83 | venn(4, lty = 5, col = "navyblue", ellipse = TRUE) 84 | ``` 85 | 86 | 87 | 88 | 89 | A 5 sets Venn diagram 90 | ``` r 91 | venn(5) 92 | ``` 93 | 94 | 95 | 96 | 97 | A 5 sets Venn diagram using ellipses 98 | ``` r 99 | venn(5, ellipse = TRUE) 100 | ``` 101 | 102 | 103 | 104 | 105 | A 5 sets Venn diagram with intersection labels 106 | ``` r 107 | venn(5, ilabels = TRUE) 108 | ``` 109 | 110 | 111 | 112 | 113 | And a predefined color style 114 | ``` r 115 | venn(5, ilabels = TRUE, zcolor = "style") 116 | ``` 117 | 118 | 119 | 120 | 121 | A union of two sets 122 | ``` r 123 | venn("1---- + ----1") 124 | ``` 125 | 126 | 127 | 128 | 129 | Same with 130 | ``` r 131 | venn("A + E", snames = "A, B, C, D, E") 132 | ``` 133 | 134 | 135 | 136 | 137 | With different colors 138 | ``` r 139 | venn("1---- , ----1", zcolor = "red, blue") 140 | ``` 141 | 142 | 143 | 144 | 145 | Same using SOP - sum of products notation 146 | ``` r 147 | venn("A, E", snames = "A, B, C, D, E", zcolor = "red, blue") 148 | ``` 149 | 150 | 151 | 152 | 153 | Same colors for the borders 154 | ``` r 155 | venn("1---- , ----1", zcolor = "red, blue", col = "red, blue") 156 | ``` 157 | 158 | 159 | 160 | 161 | A 6 sets diagram 162 | ``` r 163 | venn(6) 164 | ``` 165 | 166 | 167 | 168 | 169 | Seven sets "Adelaide" 170 | ``` r 171 | venn(7) 172 | ``` 173 | 174 | 175 | 176 | 177 | Artistic version 178 | ``` r 179 | venn(c("1000000", "0100000", "0010000", "0001000", 180 | "0000100", "0000010", "0000001", "1111111")) 181 | ``` 182 | 183 | 184 | 185 | 186 | Without all borders 187 | ``` r 188 | venn(c("1000000", "0100000", "0010000", "0001000", 189 | "0000100", "0000010", "0000001", "1111111"), 190 | borders = FALSE) 191 | ``` 192 | 193 | 194 | 195 | 196 | Using SOP - sum of products notation 197 | ``` r 198 | venn("A + B~C", snames = "A, B, C, D") 199 | ``` 200 | 201 | 202 | 203 | 204 | The input can be a list 205 | ``` r 206 | set.seed(12345) 207 | x <- list(First = 1:20, Second = 10:30, Third = sample(25:50, 15)) 208 | venn(x, ilabels = "counts") 209 | ``` 210 | 211 | 212 | 213 | 214 | 215 | Or a dataframe 216 | ``` r 217 | set.seed(12345) 218 | x <- as.data.frame(matrix(sample(0:1, 150, replace = TRUE), ncol = 5)) 219 | venn(x, ilabels = "counts") 220 | ``` 221 | 222 | 223 | 224 | 225 | Using ggplot2 graphics 226 | ``` r 227 | venn(x, ilabels = "counts", ggplot = TRUE) 228 | ``` 229 | 230 | 231 | 232 | 233 | Increasing the border size 234 | ``` r 235 | venn(x, ilabels = "counts", ggplot = TRUE, size = 1.5) 236 | ``` 237 | 238 | 239 | 240 | 241 | With dashed lines 242 | ``` r 243 | venn(x, ilabels = "counts", ggplot = TRUE, linetype = "dashed") 244 | ``` 245 | 246 | 247 | 248 | 249 | Venn diagrams for QCA objects 250 | ``` r 251 | library(QCA) 252 | 253 | data(CVF) 254 | obj <- truthTable(CVF, "PROTEST", incl.cut = 0.85) 255 | 256 | venn(obj) 257 | ``` 258 | 259 | 260 | 261 | 262 | 263 | Custom labels for intersections 264 | ``` r 265 | pCVF <- minimize(obj, include = "?") 266 | venn(pCVF$solution[[1]], zcol = "#ffdd77, #bb2020, #1188cc") 267 | cases <- paste(c("HungariansRom", "CatholicsNIreland", "AlbaniansFYROM", 268 | "RussiansEstonia"), collapse = "\n") 269 | coords <- unlist(getCentroid(getZones(pCVF$solution[[1]][2]))) 270 | text(coords[1], coords[2], labels = cases, cex = 0.85) 271 | ``` 272 | 273 | 274 | -------------------------------------------------------------------------------- /R/getZones.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `getZones` <- function(area, snames = "", ellipse = FALSE) { 32 | # borders <- getBorders() 33 | # ib <- getIntBord() 34 | 35 | funargs <- unlist(lapply(match.call(), deparse)[-1]) 36 | 37 | if (is.character(area)) { 38 | x <- gsub("[[:space:]]", "", area) 39 | 40 | if (!all(gsub("0|1|-", "", x) == "")) { 41 | 42 | if (any(grepl("\\$solution", funargs["area"]))) { 43 | obj <- get(unlist(strsplit(funargs["area"], split = "[$]"))[1]) 44 | snames <- obj$tt$options$conditions 45 | x <- paste(x, collapse = " + ") 46 | } 47 | 48 | x <- gsub("[[:space:]]", "", x) 49 | 50 | if (!all(gsub("0|1|-|\\+", "", x) == "")) { 51 | 52 | x <- admisc::translate(x, snames = snames) 53 | 54 | snames <- colnames(x) 55 | 56 | x <- paste(apply(x, 1, function(y) { 57 | y[y < 0] <- "-" 58 | paste(y, collapse="") 59 | }), collapse = "+") 60 | } 61 | 62 | # then check again 63 | if (!all(gsub("0|1|-|\\+", "", x) == "")) { 64 | cat("\n") 65 | stop("Invalid specification of the area.\n\n", call. = FALSE) 66 | } 67 | 68 | area <- unlist(strsplit(x, split="\\+")) 69 | } 70 | 71 | nofsets <- unique(nchar(area)) 72 | 73 | if (length(nofsets) > 1) { 74 | cat("\n") 75 | stop("Different numbers of sets in the area.\n\n", call. = FALSE) 76 | } 77 | 78 | if (!identical(unique(gsub("1|0|-", "", area)), "")) { 79 | cat("\n") 80 | stop("The arguent \"area\" should only contain \"1\"s, \"0\"s and dashes \"-\".\n\n", call. = FALSE) 81 | } 82 | 83 | area <- sort(unique(unlist(lapply(strsplit(area, split = ""), function(x) { 84 | dashes <- x == "-" 85 | 86 | if (any(dashes)) { 87 | sumdash <- sum(dashes) 88 | tt <- sapply(rev(seq(sumdash)), function(x) { 89 | rep.int(c(sapply(0:1, function(y) rep.int(y, 2^(x - 1)))), 2^sumdash/2^x)}) 90 | 91 | for (i in as.numeric(x[!dashes])) { 92 | tt <- cbind(tt, i) 93 | } 94 | 95 | mbase <- rev(c(1, cumprod(rev(rep(2, ncol(tt))))))[-1] 96 | tt <- tt[, match(seq(ncol(tt)), c(which(dashes), which(!dashes)))] 97 | return(as.vector(tt %*% mbase)) 98 | 99 | } 100 | else { 101 | x <- as.numeric(x) 102 | mbase <- rev(c(1, cumprod(rev(rep(2, length(x))))))[-1] 103 | return(sum(x * mbase)) 104 | } 105 | })))) 106 | } 107 | else { 108 | nofsets <- snames 109 | } 110 | 111 | area <- area + 1 112 | 113 | 114 | if (nofsets < 4 | nofsets > 5) { 115 | ellipse <- FALSE 116 | } 117 | 118 | if (identical(area, 1)) { 119 | area <- seq(2^nofsets)[-1] 120 | } 121 | 122 | if (length(area) > 1) { 123 | 124 | checkz <- logical(length(area)) 125 | names(checkz) <- area 126 | checkz[1] <- TRUE 127 | 128 | result <- list() 129 | 130 | while(!all(checkz)) { 131 | checkz <- checkZone(as.numeric(names(checkz)[1]), area, checkz, nofsets, ib, ellipse) 132 | 133 | result[[length(result) + 1]] <- as.numeric(names(checkz)[checkz]) 134 | area <- area[!checkz] 135 | checkz <- checkz[!checkz] 136 | 137 | if (length(checkz) > 0) { 138 | checkz[1] <- TRUE 139 | } 140 | } 141 | } 142 | else { 143 | result = list(area) 144 | } 145 | 146 | 147 | result <- lapply(result, function(x) { 148 | 149 | b <- ib$b[ib$s == nofsets & ib$v == as.numeric(ellipse) & is.element(ib$i, x)] 150 | 151 | if (any(duplicated(b))) { 152 | b <- setdiff(b, b[duplicated(b)]) 153 | # b <- unique(b) 154 | } 155 | 156 | # print(ib[ib$s == nofsets & ib$v == as.numeric(ellipse) & ib$b %in% b, ]) 157 | 158 | v2 <- borders[borders$s == nofsets & borders$v == as.numeric(ellipse) & borders$b == b[1], c("x", "y")] 159 | v2 <- v2[-nrow(v2), ] # get rid of the NAs, we want a complete polygon 160 | ends <- as.numeric(v2[nrow(v2), ]) 161 | 162 | checkb <- logical(length(b)) 163 | names(checkb) <- b 164 | checkb[1] <- TRUE 165 | 166 | counter <- 0 167 | 168 | while(!all(checkb)) { 169 | 170 | # do.call("rbind", lapply(... ??? 171 | 172 | for (i in which(!checkb)) { 173 | 174 | temp <- borders[borders$s == nofsets & borders$v == as.numeric(ellipse) & borders$b == b[i], c("x", "y")] 175 | 176 | flag <- FALSE 177 | if (all(ends == as.numeric(temp[1, ]))) { 178 | v2 <- rbind(v2, temp[-nrow(temp), ]) 179 | checkb[i] <- TRUE 180 | } 181 | else if (all(ends == as.numeric(temp[nrow(temp) - 1, ]))) { 182 | temp <- temp[-nrow(temp), ] 183 | v2 <- rbind(v2, temp[seq(nrow(temp), 1), ]) 184 | checkb[i] <- TRUE 185 | } 186 | 187 | if (checkb[i]) { 188 | ends <- as.vector(v2[nrow(v2), ]) 189 | } 190 | } 191 | 192 | counter <- counter + 1 193 | 194 | if (counter > length(checkb)) { 195 | # print(checkb) 196 | cat("\n") 197 | stop("Unknown error.\n\n", call. = FALSE) 198 | } 199 | } 200 | 201 | 202 | return(rbind(v2, rep(NA, 2))) 203 | }) 204 | 205 | return(result) 206 | } 207 | -------------------------------------------------------------------------------- /man/venn.Rd: -------------------------------------------------------------------------------- 1 | \name{venn} 2 | 3 | \alias{venn} 4 | 5 | \title{Draw and display a Venn diagram} 6 | 7 | \description{ 8 | This function uses a variety of input data to draw and display a Venn diagram with 9 | up to 7 sets. 10 | } 11 | 12 | \usage{ 13 | venn(x, snames = "", ilabels = NULL, ellipse = FALSE, zcolor = "bw", 14 | opacity = 0.3, plotsize = 15, ilcs = 0.6, sncs = 0.85, borders = TRUE, 15 | box = TRUE, par = TRUE, ggplot = FALSE, ...) 16 | } 17 | 18 | \arguments{ 19 | \item{x}{A single number (of sets), or a metacommand formula (see details), 20 | or a list containing set values, or a dataset containing boolean values.} 21 | \item{snames}{An optional parameter containing the names for each set.} 22 | \item{ilabels}{Complex argument, see Details.} 23 | \item{ellipse}{Logical, force the shape to an ellipse, where possible} 24 | \item{zcolor}{A vector of colors for the custom zones, or predefined colors 25 | if "style"} 26 | \item{opacity}{Degree of opacity for the color(s) specified with 27 | \code{zcolor} (less opacity, more transparency).} 28 | \item{plotsize}{Plot size, in centimeters.} 29 | \item{ilcs}{Character expansion (in base plots) or size (in ggplots) 30 | for the intersection labels} 31 | \item{sncs}{Character expansion (in base plots) or size (in ggplots) 32 | for the set names} 33 | \item{borders}{Logical: draw all intersection borders} 34 | \item{box}{Logical: draw the outside square} 35 | \item{par}{Logical: use the default, custom par settings} 36 | \item{ggplot}{Logical: plot the Venn diagram using ggplot} 37 | \item{...}{Additional parameters, mainly for the outer borders of the sets} 38 | } 39 | 40 | \details{ 41 | 42 | The argument \bold{\code{x}} can be either:\cr 43 | - a single number (of sets), between 1 and 7\cr 44 | - a metacommand (character) to draw custom intersection zones\cr 45 | - a list, containing values for the different sets: each component is a set, 46 | and only up to 7 components are processed.\cr 47 | - a dataset of boolean values.\cr 48 | 49 | A "zone" is a union of set intersections. There are exactly \bold{\code{2^k}} 50 | intersections in a Venn diagram, where \bold{\code{k}} is the number of sets. To 51 | highlight an entire set, we need a union of all possible intersections which 52 | form that set. 53 | 54 | For example, in a 3 sets diagram, the (overall) first set is composed by four 55 | intersections:\cr 56 | \bold{\code{100}} for what is in the first set but outside sets 2 and outside set 3\cr 57 | \bold{\code{101}} for the intersection between sets 1 and 3, outside set 2\cr 58 | \bold{\code{110}} for the intersection between sets 1 and 2, outside set 3\cr 59 | \bold{\code{111}} for the intersection between all three sets. 60 | 61 | A meta-language can be used to define these intersections, using the values of 62 | \bold{\code{1}} for what is inside the set, \bold{\code{0}} for what is outside 63 | the set, and \bold{\code{-}} when its either inside or outside of the set. 64 | 65 | The command \bold{\code{"1--"}} is translated as "display only the first, entire 66 | set" is equivalent with the union of the four intersections 67 | \bold{\code{"100 + 101 + 110 + 111"}}. 68 | 69 | The parameter \bold{\code{snames}} should have the same length as the number of 70 | sets specified by the parameter \bold{\code{x}}. 71 | 72 | When the parameter \bold{\code{x}} is used as a metacommand, the number of sets 73 | is calculated as the number of characters in each intersection of the 74 | metacommand. One such character command is \bold{\code{"100 + 101 + 110 + 111"}} 75 | or \bold{\code{"1--"}}, and all intersections have exactly three characters. 76 | 77 | It is also possible to use a regular, disjunctive normal form, like 78 | \bold{\code{"A"}}, which is equivalent with \bold{\code{"Abc + AbC + ABc + ABC"}}. 79 | When \bold{\code{x}} is an expression written in DNF, if a valid R statement 80 | then quoting is not even necessary. 81 | 82 | The argument \bold{\code{snames}} establishes names for the different sets, or 83 | in its absence it is taken from \bold{\code{LETTERS}}. When \bold{\code{x}} is a 84 | list or a dataframe, \bold{\code{snames}} is taken from their names. The length 85 | of the \bold{\code{snames}} indicates the total number of sets. 86 | 87 | A numerical vector can be supplied with the argument \bold{\code{ilabels}}, when 88 | the argument \bold{\code{x}} is a single number of sets. The vector should match 89 | the increasing order of the binary representation for the set intersections. 90 | 91 | This argument can also be logical, and if activated with \code{TRUE} it constructs 92 | the intersection labels from their particular combinations of 0s and 1s. 93 | 94 | Finally, it can also be specified as \code{ilabels = "counts"}, for counting the 95 | frequency of appearance of each intersection. When the argument \bold{\code{x}} 96 | is a list, the counts are taken from the number of common values for each 97 | intersection, and when \bold{\code{x}} is a dataframe, (comprised of exclusively 98 | binary values 0 and 1) the counts are taken from the number of similar rows. If 99 | a particular intersection does not have any common values (or no rows), the 100 | count "0" is left blank and not displayed in the diagram. 101 | 102 | The argument \bold{\code{ellipse}} differentiates between two types of diagrams 103 | for 4 and 5 sets. The idea is to allow for as much space as possible for each 104 | intersection (also as equal as possible) and that is impossible if preserving 105 | the shape of an ellipse. The default is to create large space for the 106 | intersections, but users who prefer an ellipse might want to set this argument 107 | to \bold{\code{TRUE}}. 108 | 109 | Colors to fill the desired zones (or entire sets) can be supplied via the 110 | argument \bold{\code{zcolor}} (the default is \bold{\code{"bw"}} black and white, 111 | which means no colors at all). Users can either chose the predefined color style, 112 | using \bold{\code{zcolor = "style"}}, or supply a vector of custom colors for 113 | each zone. If only one custom color is supplied, it will be recycled for all 114 | zones. 115 | 116 | When using \bold{\code{zcolor = "style"}}, any other additional arguments for 117 | the borders are ignored. 118 | 119 | A different set of predefined colors is used, when argument \bold{\code{x}} is a 120 | QCA type object (a truth table, either from a class \bold{\code{tt}} or from a 121 | class \bold{\code{qca}}). If custom colors are provided via \bold{\code{zcolor}}, 122 | it should have a length of 3 colors: the first for the absence of the outcome 123 | (\bold{\code{0}}), the second for the presence of the outcome (\bold{\code{1}}), 124 | and the third for the contradictions (\bold{\code{C}}). Remainders have no 125 | color, by default. 126 | 127 | The argument \bold{\code{ilcs}} works only if the intersection labels 128 | (\bold{\code{ilabels}}) have information, and it sets the size of the labels via 129 | a \bold{\code{cex}} argument. In the absence of a specific value from the user, 130 | it's default is set to 0.6 for all Venn diagrams with up to five sets, and it 131 | automatically decreases to 0.5 for six sets and 0.45 for seven sets. 132 | 133 | Via \bold{\code{...}}, users can specify additional parameters, mainly for the 134 | outer borders of the sets, as specified by \bold{\code{\link[graphics]{par}()}}, 135 | and since version 1.9 it is also used to pass additional aesthetics parameters 136 | for the ggplot2 graphics. All of them are fed either to the base function 137 | \bold{\code{\link[graphics]{lines}()}} which is responsible with the borders, or 138 | to the function \bold{\code{\link[ggplot2]{geom_path}()}} from package 139 | \pkg{ggplot2}. 140 | 141 | For up to 3 sets, the shapes can be circular. For more than 3 sets, the shape 142 | cannot be circular: for 4 and 5 sets they can be ellipses, while for more than 5 143 | sets the shapes cannot be continous (they might be monotone, but not continous). 144 | The 7 sets diagram is called "Adelaide" (Ruskey, 2005). 145 | 146 | The most challenging diagram is the one with 6 sets, where for many years it was 147 | thought a Venn diagram didn't even exist. All diagrams are symmetric, except for 148 | the one with 6 sets, where some of the sets have different shapes. The diagram 149 | in this package is an adaptation from Mamakani, K., Myrvold W. and F. Ruskey (2011). 150 | 151 | The argument \bold{\code{border}} can be used only for custom intersections 152 | and/or unions, it has no effect when \bold{\code{x}} is a list, or a data frame, 153 | or a truth table object. 154 | 155 | The argument \bold{\code{par}} is used to define a custom set of parameters when 156 | producing the plot, to ensure a square shape of about 15 cm and eliminate the 157 | outer regions. If deactivated, users can define their own size and shape of the 158 | plot using the system function \bold{\code{\link[graphics]{par}()}}. By default, 159 | the plot is always produced using a size of 1000 points for both horizontal and 160 | vertical, unless the argument \bold{\code{ggplot}} is activated, when the 161 | argument \bold{\code{par}} will have no effect. 162 | } 163 | 164 | 165 | \references{ 166 | 167 | Ruskey, F. and M. Weston. 2005. \emph{Venn diagrams}. Electronic Journal of 168 | Combinatorics, Dynamic Survey DS5. 169 | 170 | Mamakani, K., Myrvold W. and F. Ruskey. 2011. \emph{Generating all Simple 171 | Convexly-drawable Polar Symmetric 6-Venn Diagrams}. International Workshop on 172 | Combinatorial Algorithms, Victoria. LNCS, 7056, 275-286. 173 | 174 | } 175 | 176 | 177 | \examples{ 178 | 179 | # A simple Venn diagram with 3 sets 180 | venn(3) 181 | 182 | # with a vector of counts: 1 for "000", 2 for "001" etc. 183 | venn(3, counts = 1:8) 184 | 185 | # display the first whole set 186 | venn("1--") 187 | 188 | # same with 189 | venn("A", snames = "A, B, C") 190 | 191 | # an equivalent command, from the union of all intersections 192 | venn("100 + 110 + 101 + 111") 193 | 194 | # same with 195 | venn("A~B~C + AB~C + A~BC + ABC") 196 | 197 | # adding the labels for the intersections 198 | venn("1--", ilabels = TRUE) 199 | 200 | # using different parameters for the borders 201 | venn(4, lty = 5, col = "navyblue") 202 | 203 | # using ellipses 204 | venn(4, lty = 5, col = "navyblue", ellipse = TRUE) 205 | 206 | # a 5 sets Venn diagram 207 | venn(5) 208 | 209 | # a 5 sets Venn diagram using ellipses 210 | venn(5, ellipse = TRUE) 211 | 212 | # a 5 sets Venn diagram with intersection labels 213 | venn(5, ilabels = TRUE) 214 | 215 | # and a predefined color style 216 | venn(5, ilabels = TRUE, zcolor = "style") 217 | 218 | # a union of two sets 219 | venn("1---- + ----1") 220 | 221 | # same with 222 | venn("A + E", snames = "A, B, C, D, E") 223 | 224 | # with different colors 225 | venn("1---- , ----1", zcolor = "red, blue") 226 | 227 | # same with 228 | venn("A, E", snames = "A, B, C, D, E", zcolor = "red, blue") 229 | 230 | # same colors for the borders 231 | venn("1---- , ----1", zcolor = "red, blue", col = "red, blue") 232 | 233 | # 6 sets diagram 234 | venn(6) 235 | 236 | # 7 sets "Adelaide" 237 | venn(7) 238 | 239 | 240 | # artistic version 241 | venn(c("1000000", "0100000", "0010000", "0001000", 242 | "0000100", "0000010", "0000001", "1111111")) 243 | 244 | # without all borders 245 | venn(c("1000000", "0100000", "0010000", "0001000", 246 | "0000100", "0000010", "0000001", "1111111"), 247 | borders = FALSE) 248 | 249 | 250 | # using sum of products notation 251 | venn("A + B~C", snames = "A, B, C, D") 252 | 253 | 254 | # when x is a list 255 | set.seed(12345) 256 | x <- list(First = 1:20, Second = 10:30, Third = sample(25:50, 15)) 257 | venn(x, ilabels = "counts") 258 | 259 | 260 | # when x is a dataframe 261 | set.seed(12345) 262 | x <- as.data.frame(matrix(sample(0:1, 150, replace = TRUE), ncol = 5)) 263 | venn(x, ilabels = "counts") 264 | 265 | 266 | # producing a ggplot2 graphics 267 | venn(x, ilabels = "counts", ggplot = TRUE) 268 | 269 | # increasing the border size 270 | venn(x, ilabels = "counts", ggplot = TRUE, size = 1.5) 271 | 272 | # with dashed lines 273 | venn(x, ilabels = "counts", ggplot = TRUE, linetype = "dashed") 274 | 275 | 276 | \dontrun{ 277 | # produce Venn diagrams for QCA objects 278 | library(QCA) 279 | 280 | data(CVF) 281 | obj <- truthTable(CVF, "PROTEST", incl.cut = 0.85) 282 | 283 | venn(obj) 284 | 285 | # to set opacity based on inclusion scores 286 | # (less inclusion, more transparent) 287 | 288 | venn(obj, opacity = obj$tt$incl) 289 | 290 | # custom labels for intersections 291 | 292 | pCVF <- minimize(obj, include = "?") 293 | venn(pCVF$solution[[1]], zcol = "#ffdd77, #bb2020, #1188cc") 294 | cases <- paste(c("HungariansRom", "CatholicsNIreland", "AlbaniansFYROM", 295 | "RussiansEstonia"), collapse = "\n") 296 | coords <- unlist(getCentroid(getZones(pCVF$solution[[1]][2]))) 297 | text(coords[1], coords[2], labels = cases, cex = 0.85) 298 | } 299 | 300 | } 301 | 302 | 303 | \keyword{functions} 304 | -------------------------------------------------------------------------------- /man/figures/fig01.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /R/plotRules.R: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2016-2024, Adrian Dusa 2 | # All rights reserved. 3 | # 4 | # Redistribution and use in source and binary forms, with or without 5 | # modification, in whole or in part, are permitted provided that the 6 | # following conditions are met: 7 | # * Redistributions of enclosed data must cite this package according to 8 | # the citation("venn") command specific to this R package, along with the 9 | # appropriate weblink to the CRAN package "venn". 10 | # * Redistributions of enclosed data in other R packages must list package 11 | # "venn" as a hard dependency in the Imports: field. 12 | # * Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # * Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # * The names of its contributors may NOT be used to endorse or promote products 18 | # derived from this software without specific prior written permission. 19 | # 20 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | # DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY 24 | # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 27 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | `plotRules` <- function ( 32 | rules, zcolor = "bw", ellipse = FALSE, opacity = 0.3, allborders = TRUE, 33 | box = TRUE, gvenn = NULL, ... 34 | ) { 35 | # sets <- getSets() 36 | zeroset <- matrix(c(0, 1000, 1000, 0, 0, 0, 0, 1000, 1000, 0), ncol = 2) 37 | colnames(zeroset) <- c("x", "y") 38 | 39 | default <- identical(zcolor, "style") 40 | 41 | # assume the zones cover all sets (if rules is a number that is TRUE by default, anyways) 42 | allsets <- TRUE 43 | 44 | # create dummy global variables x and y to comply with R CMD check 45 | # when they are used for aes(x, y) in ggplots 46 | x <- NULL 47 | y <- NULL 48 | 49 | 50 | if (is.list(rules)) { 51 | 52 | if (identical(zcolor, "bw")) { 53 | zcolor <- rep("#96bc72", length.out = length(rules)) 54 | } 55 | else if (identical(zcolor, "style")) { 56 | zcolor <- colorRampPalette(c("red", "blue", "green", "yellow"))(length(rules)) 57 | } 58 | else { 59 | zcolor <- rep(zcolor, length.out = length(rules)) 60 | } 61 | 62 | 63 | nofsets <- unique(unlist(lapply(rules, function(x) { 64 | nchar(unlist(strsplit(x, split = "\\+"))) 65 | }))) 66 | 67 | tt <- sapply(rev(seq(nofsets)), function(x) { 68 | rep(c(sapply(0:1, function(y) rep(y, 2^(x - 1)))), 2^nofsets/2^x) 69 | }) 70 | 71 | rownames(tt) <- seq(nrow(tt)) - 1 72 | 73 | rowns <- lapply(rules, function(x) { 74 | sort(unique(unlist(lapply(strsplit(x, split = "\\+"), function(x) { 75 | unlist(lapply(strsplit(x, split = ""), function(x) { 76 | 77 | ttc <- tt 78 | for (j in seq(length(x))) { 79 | if (x[j] != "-") { 80 | ttc <- subset(ttc, ttc[, j] == x[j]) 81 | } 82 | } 83 | 84 | return(as.numeric(rownames(ttc))) 85 | })) 86 | 87 | })))) 88 | }) 89 | 90 | 91 | # check if any of the remaining rows define a whole set 92 | 93 | # wholesets will be a numeric vector: 94 | # 0 if it's not a whole set 95 | # the number of the set (if it is whole), from the order in the truth table 96 | 97 | wholesets <- unlist(lapply(rules, function(x) { 98 | ifelse(nchar(gsub("-", "", x)) == 1, as.vector(regexpr("[0-9]", x)), 0) 99 | })) 100 | 101 | allwhole <- all(wholesets > 0) 102 | 103 | # verify if the rules cover all sets 104 | allsets <- length(rules) == nofsets & allwhole 105 | 106 | 107 | if (nofsets < 4 | nofsets > 5) { 108 | ellipse <- FALSE 109 | } 110 | 111 | zones <- vector("list", length(wholesets)) 112 | 113 | irregular <- unlist(lapply(rowns, function(x) any(x == 0))) 114 | 115 | if (any(irregular)) { # inverse, the area outside a shape (or outside all shapes) 116 | for (i in which(irregular)) { 117 | zones[[i]] <- getZones(rowns[[i]], nofsets, ellipse) 118 | polygons <- rbind(zeroset, rep(NA, 2), zones[[i]][[1]]) 119 | polygons <- polygons[-nrow(polygons), ] # needed...? 120 | 121 | if (is.null(gvenn)) { 122 | polypath(polygons, rule = "evenodd", col = adjustcolor(zcolor[i], alpha.f = opacity), border = NA) 123 | } else { 124 | gvenn <- gvenn + ggpolypath::geom_polypath(polygons, rule = "evenodd", col = adjustcolor(zcolor[i], alpha.f = opacity)) 125 | } 126 | } 127 | } 128 | 129 | 130 | if (any(!irregular)) { # normal shapes 131 | if (any(wholesets > 0)) { 132 | for (i in which(wholesets > 0)) { 133 | # [[1]] simulates getZones() because sometimes there might be multiple zones 134 | zones[[i]][[1]] <- sets[ 135 | sets$s == nofsets & 136 | sets$v == as.numeric(ellipse) & 137 | sets$n == wholesets[i], 138 | c("x", "y") 139 | ] 140 | } 141 | } 142 | 143 | if (any(wholesets == 0)) { 144 | for (i in which(wholesets == 0 & !irregular)) { 145 | zones[[i]] <- getZones(rowns[[i]], nofsets, ellipse) 146 | } 147 | } 148 | 149 | 150 | for (i in seq(length(zones))) { 151 | if (!irregular[i]) { 152 | for (j in seq(length(zones[[i]]))) { 153 | if (is.null(gvenn)) { 154 | polygon(zones[[i]][[j]], col = adjustcolor(zcolor[i], alpha.f = opacity), border = NA) 155 | } else { 156 | gvenn <- gvenn + ggplot2::geom_polygon(data = zones[[i]][[j]], ggplot2::aes(x, y), fill = adjustcolor(zcolor[i], alpha.f = opacity)) 157 | } 158 | } 159 | } 160 | } 161 | } 162 | } 163 | else if (is.numeric(rules)) { 164 | nofsets <- rules 165 | allsets <- TRUE 166 | allwhole <- TRUE 167 | 168 | if (identical(zcolor, "style")) { 169 | zcolor <- colorRampPalette(c("red", "yellow", "green", "blue"))(nofsets) 170 | } 171 | else if (!identical(zcolor, "bw")) { 172 | zcolor <- rep(zcolor, length.out = nofsets) 173 | } 174 | 175 | if (nofsets < 4 | nofsets > 5) { 176 | ellipse <- FALSE 177 | } 178 | } 179 | else { 180 | admisc::stopError("Something went wrong.") 181 | } 182 | 183 | 184 | other.args <- list(...) 185 | 186 | if (box) { 187 | if (is.null(gvenn)) { 188 | lines(zeroset) 189 | } 190 | else { 191 | gvenn <- gvenn + ggplot2::geom_path(data = as.data.frame(zeroset), ggplot2::aes(x, y)) 192 | } 193 | } 194 | 195 | if (!identical(zcolor, "bw")) { 196 | # border colors, a bit darker 197 | bcolor <- rgb(t(col2rgb(zcolor)/1.4), maxColorValue = 255) 198 | } 199 | else { 200 | bcolor <- "#000000" 201 | } 202 | 203 | 204 | if (allsets & allwhole) { 205 | temp <- sets[sets$s == nofsets & sets$v == as.numeric(ellipse), c("x", "y")] 206 | if (is.numeric(rules) & !identical(zcolor, "bw")) { 207 | # the zones have not been plotted yet 208 | if (is.null(gvenn)) { 209 | polygon(temp, col = adjustcolor(zcolor, alpha.f = opacity), border = NA) 210 | } 211 | else { 212 | breaks <- which(apply(temp, 1, function(x) any(is.na(x)))) 213 | start <- 1 214 | for (b in seq(length(breaks))) { 215 | if (b > 1) start <- breaks[b - 1] + 1 216 | gvenn <- gvenn + ggplot2::geom_polygon(data = temp[seq(start, breaks[b] - 1), ], ggplot2::aes(x, y), fill = adjustcolor(zcolor[b], alpha.f = opacity)) 217 | } 218 | } 219 | } 220 | 221 | # now the borders 222 | 223 | if (default) { 224 | 225 | # the default set of colors ignores all other additional parameters for the borders 226 | 227 | for (i in seq(nofsets)) { 228 | temp <- sets[sets$s == nofsets & sets$v == as.numeric(ellipse) & sets$n == i, c("x", "y")] 229 | if (is.null(gvenn)) { 230 | suppressWarnings( lines(temp, col = bcolor[i])) 231 | } 232 | else { 233 | breaks <- which(apply(temp, 1, function(x) any(is.na(x)))) 234 | start <- 1 235 | for (b in seq(length(breaks))) { 236 | if (b > 1) start <- breaks[b - 1] + 1 237 | gvenn <- gvenn + ggplot2::geom_path(ggplot2::aes(x, y), data = temp[seq(start, breaks[b] - 1), ], col = bcolor[i]) 238 | } 239 | } 240 | } 241 | } 242 | else { 243 | 244 | if (length(other.args) > 0) { 245 | 246 | # there might be different border colors for each zone (set in this case) 247 | # arguments are recycled to the length of the zones 248 | other.args <- lapply(other.args, function(x) { 249 | rep(x, length.out = nofsets) 250 | }) 251 | 252 | for (i in seq(nofsets)) { 253 | plotdata <- sets[sets$s == nofsets & sets$v == as.numeric(ellipse) & sets$n == i, c("x", "y")] 254 | 255 | if (is.null(gvenn)) { 256 | seplines <- list(as.name("lines"), x = plotdata) 257 | suppress <- list(as.name("suppressWarnings")) 258 | 259 | for (j in names(other.args)) { 260 | seplines[[j]] <- other.args[[j]][i] 261 | } 262 | 263 | suppress[[2]] <- as.call(seplines) 264 | 265 | eval(as.call(suppress)) 266 | } 267 | else { 268 | seplines <- list(ggplot2::geom_path) 269 | if (all(is.na(tail(plotdata, 1)))) { 270 | # to remove the annoying warning "removed 1 row containing missing data" 271 | plotdata <- plotdata[-nrow(plotdata), , drop = FALSE] 272 | } 273 | seplines$mapping <- ggplot2::aes(x, y) 274 | seplines$data <- plotdata 275 | for (j in names(other.args)) { 276 | seplines[[j]] <- other.args[[j]][i] 277 | } 278 | 279 | gvenn <- gvenn + eval(as.call(seplines)) 280 | } 281 | 282 | } 283 | } 284 | else { 285 | # print borders in black 286 | temp <- sets[sets$s == nofsets & sets$v == as.numeric(ellipse), c("x", "y")] 287 | if (is.null(gvenn)) { 288 | suppressWarnings(lines(temp)) 289 | } 290 | else { 291 | breaks <- which(apply(temp, 1, function(x) any(is.na(x)))) 292 | start <- 1 293 | for (b in seq(length(breaks))) { 294 | if (b > 1) start <- breaks[b - 1] + 1 295 | gvenn <- gvenn + ggplot2::geom_path(ggplot2::aes(x, y), data = temp[seq(start, breaks[b] - 1), ]) 296 | } 297 | } 298 | } 299 | } 300 | } 301 | else { 302 | 303 | # first print all borders in black 304 | # (important to begin with this, the zones might not cover all intersections) 305 | if (allborders) { 306 | temp <- sets[sets$s == nofsets & sets$v == as.numeric(ellipse), c("x", "y")] 307 | if (is.null(gvenn)) { 308 | suppressWarnings(lines(temp)) 309 | } 310 | else { 311 | breaks <- which(apply(temp, 1, function(x) any(is.na(x)))) 312 | start <- 1 313 | for (b in seq(length(breaks))) { 314 | if (b > 1) start <- breaks[b - 1] + 1 315 | gvenn <- gvenn + ggplot2::geom_path(ggplot2::aes(x, y), data = temp[seq(start, breaks[b] - 1), ]) 316 | } 317 | } 318 | } 319 | else { 320 | if (!is.element("col", names(other.args))) { 321 | other.args$col <- "black" 322 | } 323 | } 324 | 325 | # surely this is not numeric, there are zones already calculated 326 | 327 | 328 | if (default) { 329 | 330 | for (i in seq(length(zones))) { 331 | for (j in seq(length(zones[[i]]))) { 332 | if (is.null(gvenn)) { 333 | suppressWarnings(lines(zones[[i]][[j]], col = bcolor[i])) 334 | } 335 | else { 336 | temp <- zones[[i]][[j]] 337 | breaks <- which(apply(temp, 1, function(x) any(is.na(x)))) 338 | start <- 1 339 | for (b in seq(length(breaks))) { 340 | if (b > 1) start <- breaks[b - 1] + 1 341 | gvenn <- gvenn + ggplot2::geom_path(ggplot2::aes(x, y), data = temp[seq(start, breaks[b] - 1), ], col = bcolor[i]) 342 | } 343 | } 344 | } 345 | } 346 | 347 | } 348 | else { 349 | 350 | if (length(other.args) > 0) { 351 | 352 | # arguments are recycled to the length of the zones 353 | other.args <- lapply(other.args, function(x) { 354 | rep(x, length.out = length(rules)) 355 | }) 356 | 357 | for (i in seq(length(zones))) { 358 | 359 | for (j in seq(length(zones[[i]]))) { 360 | if (is.null(gvenn)) { 361 | seplines <- list(as.name("lines"), x = zones[[i]][[j]]) 362 | suppress <- list(as.name("suppressWarnings")) 363 | 364 | if (any(names(other.args) == "col")) { 365 | other.args$col <- admisc::splitstr(other.args$col) 366 | } 367 | 368 | for (j in names(other.args)) { 369 | seplines[[j]] <- other.args[[j]][i] 370 | } 371 | 372 | suppress[[2]] <- as.call(seplines) 373 | 374 | eval(as.call(suppress)) 375 | } 376 | else { 377 | temp <- zones[[i]][[j]] 378 | breaks <- which(apply(temp, 1, function(x) any(is.na(x)))) 379 | start <- 1 380 | for (b in seq(length(breaks))) { 381 | 382 | if (b > 1) start <- breaks[b - 1] + 1 383 | 384 | seplines <- list(ggplot2::geom_path) 385 | seplines[["data"]] <- temp[seq(start, breaks[b] - 1), ] 386 | seplines[["mapping"]] <- ggplot2::aes(x, y) 387 | 388 | if (any(names(other.args) == "col")) { 389 | other.args$col <- admisc::splitstr(other.args$col) 390 | } 391 | 392 | for (j in names(other.args)) { 393 | seplines[[j]] <- other.args[[j]][i] 394 | } 395 | 396 | gvenn <- gvenn + eval(as.call(seplines)) 397 | } 398 | } 399 | } 400 | } 401 | } 402 | } 403 | } 404 | 405 | if (!is.null(gvenn)) { 406 | return(gvenn) 407 | } 408 | } 409 | -------------------------------------------------------------------------------- /man/figures/fig05.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /man/figures/fig03.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /man/figures/fig06.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /man/figures/fig18.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /man/figures/fig08.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /man/figures/fig02.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | --------------------------------------------------------------------------------