VennDiagram/0000755000176200001440000000000014225406014012443 5ustar liggesusersVennDiagram/NAMESPACE0000644000176200001440000000117514225131771013673 0ustar liggesusersexport( add.title, adjust.venn, decide.special.case, draw.quad.venn, draw.single.venn, draw.pairwise.venn, draw.sp.case, draw.sp.case.preprocess, draw.sp.case.scaled, draw.triple.venn, draw.quintuple.venn, ell2poly, ellipse, find.cat.pos, find.dist, find.intersect, flip.venn, rotate, rotate.sp, rotate.venn.degrees, venn.diagram, calculate.overlap, get.venn.partitions, make.truth.table ) importFrom("grDevices", "dev.off", "png", "svg", "tiff") importFrom("stats", "aggregate", "setNames", "phyper") importFrom("utils", "capture.output", "combn") importFrom("methods", "is") import(grid, futile.logger ) VennDiagram/data/0000755000176200001440000000000014127700757013370 5ustar liggesusersVennDiagram/data/plotsFour.rda0000644000176200001440000000215414127700757016057 0ustar liggesusers7zXZi"6!XN\-])TW"nRʟ7i|Mj{]iO|bz}o{ QV3C;rk\vI+eL.::-ļ|ۉʜnz/p]:(WCYB@mSb9?5~*߶_; }#ޜ:zC;]Vh"츥QO/p8b"UAJzSG&X&#;~duC@F̲Fn}gÂﴖʹ1 zo],ӡuzd#@ðw1|>KYlD|!5ʼv-~y9$oFjbTڀTىꬭhQ7U'wurרK)5|Pvໝ-D 4¥O)ƒC A]Ⱦˏ깥2nfk!V F7ʒ`j8HlKu]<vmCMpsqTcvLw׳c&O wZP,OI1lQzts";X)k| >,犕?(@r~mZxAy3t\0Dw$vU>*TjGfܳ?l g I6?lpʹ~ق1ouv)"lZ*o1\.hARڮAq D%Q2 ikQڜB;]+ 㒓Rbb,]+`^/(ntHTULe*G7>:|5'hP 9cw4o @RDjҝtl5_;/BqnfXAǙ.CYn#= }2 0CWrz&W'/s˜~m!fXV?ǰ/JhD].x!`Zp0 YZVennDiagram/data/plotsFive.rda0000644000176200001440000000317414127700757016040 0ustar liggesusers7zXZi"6!X =])TW"nRʟ7i|Mj{]iO|bz}o5LR[4؊=Sz꟠xFG)"]dۜxiA'..7Yz*E ij$Nk٣9|rT]g7 Ȃ{*pN2Ļ,sP8a 8qf[4H8 $9O[xRC<#W $oz/˯'v;YQ91d^g})lH{ZZFϕέ'].@#m sͥl53,BIZX 8Ŵ_Zr e6P$D7Bᐼ|ȟpC)5=Sk,.rO?Vu1[$=Y LH=} 6M2c=QR] U #cWxzo)Ec:Y "4F92756ڤ_1p^S1ݻ(0ȇ'^2n'QIBboF(( 2N_׭+v}<.1d@Le&yT&~DͶG ~@vm 7opU 6H ~Π)oejRzm}jRR-\2q<38}58S{_ MUO%њ'N8I8\ o,ƞ7]sJ\s`D6[; e p"~$jҨ4+'$҉!6T.AeP.؀nFLZL&E0XU^J*}UyɚzqÛS:T;Lr7{n&?~YVt,yps~XÀܵʡj[!O2%ځ` ~}lJGĈۥxIËDP [~OfoUB~1|Z)xEd-l]<3tVukLb9HLEK 1zszHR3V&+ֶ)嫒J^P5+$(*)Ĩ,|'D(ߘ}T@ϒSN{%PҁJWF7 o( Z"J$toH?b7Mt45 y>>0 YZVennDiagram/data/plotsTwo.rda0000644000176200001440000000241014127700757015710 0ustar liggesusers7zXZi"6!X[])TW"nRʟ7i|Mj{]iO|bzErŝ{yZ\׺%zG3B#3u)EiWVLÙ" 3#rSG1frʕC G]짼^xkPg]!љ/3[Ji1N̼40X|Hq1d'Ja1zAQeYvk3M;*xIYtB۾{j]IhX7i Tʅδ'ߦuf r >m^61zmRYu:c?Ǿ%x='YkynjOigK`+أxo/>*ALkkq#vtC~qtP4-Pd4~ZT7{2cYmHST8+inW~|wk!YBfzj*Q3iؒCXس c^Lc eIosN,f3%{Ix[14է $D 6y*8#i 雁f$<䌢 kfKz/bX'|1cKg}=T[y}A*#0( @tlJG֏c\\'UȪ9&O;A0F4ީ| C:O'7ܯ)لݷzOY 2x Q`| P+Acc7V9@H{}TG}ѻK(NOyaXsJh[pN% (Fa\P_S"_g"{yc/s2c}W}S/+i~ݑ8jJ$ SV~3m2Of]40 $ʋ*|^0!x6rIl P~kGbsS50(a_5 x ǩyMEq)q3*x.k-՗iH_LG> 4mE!⑪dvQ)]"%}+b!,/B #uߑ3f& 闃['-4$v+ f[Ahj;駶T>IɢRCjxoeY+||r|+aޟcba&$eUv">O{!*k ߷`>0 YZVennDiagram/data/plotsOne.rda0000644000176200001440000000130014127700757015655 0ustar liggesusers7zXZi"6!X])TW"nRʟ7i|Mj{]iO|bz`ryjsǎ{#9@].? QԴe6_ACP{ImIl>|8𹝌|& W(Oi7hiK$w:w8Vʳ =Q;aam|IP3eHJ9H=8QPE}þ wMb^cJva2Kg ڞ.PoioJV*[imtkW[$HvPi4TT]#:w 'k"`(bR1PYFQٱ7=A1IpD[rrjS(8m';rVƧ`dh[C|X WR$I2C{rn [[y^|֦h6U_pRDq[P?9ύT ~S=m+PBpЃքbΣ<^zх[&RG>k Zsw{ԫ}F*zHsFgq6^Ӓ'ӁsLXNjζ#7SY(8I#;ѡ"YD՚)%,gr[K t) >0 YZVennDiagram/data/plotsThree.rda0000644000176200001440000001053014127700757016210 0ustar liggesusers7zXZi"6!XY])TW"nRʟ7i|Mj{]iO|bz_-K^HA ҥ\U=q>j6ct" }E )'3j@ 2"c(473Xo'HL"7ؗbvou5=Z!wΌNwsΗCi؟ڙu:{CZ/_S0O~J &7־6\e 'g2ҾnDU%CZF0# _$Xj.Itpw|'.RO; 3L3r{-r>`{:E|I m=bj*^5h< [zreΦQZ}}K\Jɹ 1@He~a&5m~.:%Ӡ'ꖵ?i&Sd y,f .PW[zGC65==3qɩ& ' k[بIhP 녅\[YL+ ș5c B4ӞI,UC 6H%$&@H$1_<~!-X3iCZoZ0d%";0ιt~#<rp$1jp$pI1?;N8ޭ=Q$Ca:^ m6[KYȩQcoNm8ų7Q(@U1,jpLqr%2bHz0@)]ȐNIP#e3Rq/* M]yK}GD\i>x}%N=0~P2Q[xm$jtl04aPVj2_G"mvWa6 +{,6h{:yn tRhL+g=F##ѣNR]<] /yh +풄?EeX2F]TyFg\Er$Hڄ v5V'4i@쮚bz2Em Yzg:?`Bgxq@|uPH8WW4$D:/chnĸp `Ĭh6|"I6~ 3aV18 wUy 1MWw]wZ8eu_z$V-*d;v%3I|넎*E. =^bAHѾ]Xg=t6]<:?j$\6Xȡq.?'Q$~׼c&iҽ,g%tQ:%= 5.Y$s0n4uS4ҫ_cw~jJg m}WOZiv Cruⶱ[ܪX[vD?\{rrCzvw+1)Yk ~?z4‰ βq4FL}37,v: sn4N8[F} /9@3$&) :F7 vΈ-G}axYd޳ Z=V{.8N7JsGǹXFn5uY ʴNiMxu[%` G3V Ɓ>%BZ< ΋~.>I^b%x9TKơKE?(|g0P4.&^ L򟬤^QKsf2-{~,]x˟'lf|sBCg9դCJy+`ug9u}J\`)$Dں| QRxv㛁&,8ϲ<?L[T,HZT5@V 6Ec3**p2} 0Y9kWs(,9DrBPu[>TF?<)hZDQx.xF63궃J7ۈ$Ւ5MfP!T(y EġwO)Dz%% 0qxXc69ܯYD0oJ(~#OBghyfưEIw]&,i7&k$T@I|Յ? TlxmghIh O"«˙YXh_qݫho؟Lx'\}6';<{6@w=V쬃!OQLDnTVʋtyj'zxp˜~U۟5{o>aC[Ld_h)PλIw18 q٤xAGU|V?W崎d9UcH"O=0.q6x}n֧*1QPr8:Pֺ8ؙ8/HM,X-&cQW}2˩ʨpJnV[3,L>솏ohY`*ӥXۚ @"hzPʛm<"$Mexznu4Zqp)8k 7Q 6$bF챼kSs9 O>H R.K/ ml5nYmw(g]p^'a"ڄ .>0 YZVennDiagram/man/0000755000176200001440000000000014221171123013212 5ustar liggesusersVennDiagram/man/VennDiagram-package.Rd0000644000176200001440000000102514221171123017263 0ustar liggesusers\name{VennDiagram-package} \alias{VennDiagram-package} \alias{VennDiagram} \docType{package} \title{Venn diagram plotting} \description{Functions to plot high-resolution and highly-customizable Venn and Euler plots.} \details{ \tabular{ll}{ Package: \tab VennDiagram\cr Type: \tab Package\cr Version: \tab 1.6.0\cr Date: \tab 2013-04-10\cr License: \tab GPL-2\cr LazyLoad: \tab yes\cr } } \author{ Author: Hanbo Chen \cr Maintainer: Dr. Paul C. Boutros } \keyword{ package } VennDiagram/man/draw.quintuple.venn.Rd0000644000176200001440000001731414221171123017436 0ustar liggesusers\name{draw.quintuple.venn} \alias{draw.quintuple.venn} \title{Draw a Venn Diagram with Five Sets} \description{Creates a Venn diagram with five sets.} \usage{ draw.quintuple.venn(area1, area2, area3, area4, area5, n12, n13, n14, n15, n23, n24, n25, n34, n35, n45, n123, n124, n125, n134, n135, n145, n234, n235, n245, n345, n1234, n1235, n1245, n1345, n2345, n12345, category = rep("", 5), lwd = rep(2, 5), lty = rep("solid", 5), col = rep("black", 5), fill = NULL, alpha = rep(0.5, 5), label.col = rep("black", 31), cex = rep(1, 31), fontface = rep("plain", 31), fontfamily = rep("serif", 31), cat.pos = c(0, 287.5, 215, 145, 70), cat.dist = rep(0.2, 5), cat.col = rep("black", 5), cat.cex = rep(1, 5), cat.fontface = rep("plain", 5), cat.fontfamily = rep("serif", 5), cat.just = rep(list(c(0.5, 0.5)), 5), rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, cex.prop = NULL, print.mode = "raw", sigdigs = 3, direct.area = FALSE, area.vector = 0, ...) } \arguments{ \item{area1}{The size of the first set} \item{area2}{The size of the second set} \item{area3}{The size of the third set} \item{area4}{The size of the fourth set} \item{area5}{The size of the fifth set} \item{n12}{The size of the intersection between the first and the second set} \item{n13}{The size of the intersection between the first and the third set} \item{n14}{The size of the intersection between the first and the fourth set} \item{n15}{The size of the intersection between the first and the fifth set} \item{n23}{The size of the intersection between the second and the third set} \item{n24}{The size of the intersection between the second and the fourth set} \item{n25}{The size of the intersection between the second and the fifth set} \item{n34}{The size of the intersection between the third and the fourth set} \item{n35}{The size of the intersection between the third and the fifth set} \item{n45}{The size of the intersection between the fourth and the fifth set} \item{n123}{The size of the intersection between the first, second and third sets} \item{n124}{The size of the intersection between the first, second and fourth sets} \item{n125}{The size of the intersection between the first, second and fifth sets} \item{n134}{The size of the intersection between the first, third and fourth sets} \item{n135}{The size of the intersection between the first, third and fifth sets} \item{n145}{The size of the intersection between the first, fourth and fifth sets} \item{n234}{The size of the intersection between the second, third and fourth sets} \item{n235}{The size of the intersection between the second, third and fifth sets} \item{n245}{The size of the intersection between the second, fourth and fifth sets} \item{n345}{The size of the intersection between the third, fourth and fifth sets} \item{n1234}{The size of the intersection between the first, second, third and fourth sets} \item{n1235}{The size of the intersection between the first, second, third and fifth sets} \item{n1245}{The size of the intersection between the first, second, fourth and fifth sets} \item{n1345}{The size of the intersection between the first, third, fourth and fifth sets} \item{n2345}{The size of the intersection between the second, third, fourth and fifth sets} \item{n12345}{The size of the intersection between all five sets} \item{category}{A vector (length 5) of strings giving the category names of the sets} \item{lwd}{A vector (length 5) of numbers giving the line width of the circles' circumferences} \item{lty}{A vector (length 5) giving the dash pattern of the circles' circumferences} \item{col}{A vector (length 5) giving the colours of the circles' circumferences} \item{fill}{A vector (length 5) giving the colours of the circles' areas} \item{alpha}{A vector (length 5) giving the alpha transparency of the circles' areas} \item{label.col}{A vector (length 31) giving the colours of the areas' labels} \item{cex}{A vector (length 31) giving the size of the areas' labels} \item{fontface}{A vector (length 31) giving the fontface of the areas' labels} \item{fontfamily}{A vector (length 31) giving the fontfamily of the areas' labels} \item{cat.pos}{A vector (length 5) giving the positions (in degrees) of the category names along the circles, with 0 (default) at 12 o'clock} \item{cat.dist}{A vector (length 5) giving the distances (in npc units) of the category names from the edges of the circles (can be negative)} \item{cat.cex}{A vector (length 5) giving the size of the category names} \item{cat.col}{A vector (length 5) giving the colours of the category names} \item{cat.fontface}{A vector (length 5) giving the fontface of the category names} \item{cat.fontfamily}{A vector (length 5) giving the fontfamily of the category names} \item{cat.just}{List of 5 vectors of length 2 indicating horizontal and vertical justification of each category name} \item{rotation.degree}{Number of degrees to rotate the entire diagram} \item{rotation.centre}{A vector (length 2) indicating (x,y) of the rotation centre} \item{ind}{Boolean indicating whether the function is to automatically draw the diagram before returning the gList object or not} \item{cex.prop}{A function or string used to rescale areas} \item{print.mode}{Can be either 'raw' or 'percent'. This is the format that the numbers will be printed in. Can pass in a vector with the second element being printed under the first} \item{sigdigs}{If one of the elements in print.mode is 'percent', then this is how many significant digits will be kept} \item{direct.area}{If this is equal to true, then the vector passed into area.vector will be directly assigned to the areas of the corresponding regions. Only use this if you know which positions in the vector correspond to which regions in the diagram} \item{area.vector}{An argument to be used when direct.area is true. These are the areas of the corresponding regions in the Venn Diagram} \item{...}{Additional arguments to be passed, including \code{margin}, which indicates amount of whitespace around the final diagram in npc units} } \details{ The function defaults to placing the ellipses representing the areas 1 to 5 in a counterclockwise fashion. Refer to the example below to see how the 31 partial areas are ordered. Arguments with length of 31 (label.col, cex, fontface, fontfamily) will follow the order in the example. } \value{ Returns an object of class gList containing the grid objects that make up the diagram. Also displays the diagram in a graphical device unless specified with ind = FALSE. Grid::grid.draw can be used to draw the gList object in a graphical device. } \author{Hanbo Chen} \examples{ # Reference five-set diagram venn.plot <- draw.quintuple.venn( area1 = 301, area2 = 321, area3 = 311, area4 = 321, area5 = 301, n12 = 188, n13 = 191, n14 = 184, n15 = 177, n23 = 194, n24 = 197, n25 = 190, n34 = 190, n35 = 173, n45 = 186, n123 = 112, n124 = 108, n125 = 108, n134 = 111, n135 = 104, n145 = 104, n234 = 111, n235 = 107, n245 = 110, n345 = 100, n1234 = 61, n1235 = 60, n1245 = 59, n1345 = 58, n2345 = 57, n12345 = 31, category = c("A", "B", "C", "D", "E"), fill = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"), cat.col = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"), cat.cex = 2, margin = 0.05, cex = c(1.5, 1.5, 1.5, 1.5, 1.5, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 1, 1, 1, 1, 1.5), ind = TRUE ); # Writing to file tiff( filename = tempfile( pattern = 'Quintuple_Venn_diagram', fileext = '.tiff' ), compression = "lzw" ); grid.draw(venn.plot); dev.off(); } \keyword{hplot} VennDiagram/man/venn.plot.Rd0000644000176200001440000000047714112260207015435 0ustar liggesusers\name{venn.plot} \alias{venn.plot} \title{A collection of venn diagram grob objects} \description{Examples of venn.diagram. For testing that the venn.diagrams are generated properly} \value{Depends on which file is loaded. Can be a list of one to five category Venn Diagrams} \author{Zhiyuan Wang} \keyword{ internal } VennDiagram/man/draw.sp.case.preprocess.Rd0000644000176200001440000000115014112260207020153 0ustar liggesusers\name{draw.sp.case.preprocess} \alias{draw.sp.case.preprocess} \title{Draw a special Venn Diagram with Three Sets. These are the non scaled cases} \description{Special case of draw.triple.venn. Internal use only.} \value{See draw.triple.venn} \author{Zhiyuan Wang} \examples{ venn.plot <- draw.triple.venn( area1 = 4, area2 = 3, area3 = 4, n12 = 2, n23 = 2, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ); dev.off(); } \keyword{ internal } VennDiagram/man/venn.diagram.Rd0000644000176200001440000005221414221171123016056 0ustar liggesusers\name{venn.diagram} \alias{venn.diagram} \title{Make a Venn Diagram} \description{This function takes a list and creates a publication-quality TIFF Venn Diagram} \usage{ venn.diagram(x, filename, disable.logging = FALSE, height = 3000, width = 3000, resolution = 500, imagetype = "tiff", units = "px", compression = "lzw", na = "stop", main = NULL, sub = NULL, main.pos = c(0.5, 1.05), main.fontface = "plain", main.fontfamily = "serif", main.col = "black", main.cex = 1, main.just = c(0.5, 1), sub.pos = c(0.5, 1.05), sub.fontface = "plain", sub.fontfamily = "serif", sub.col = "black", sub.cex = 1, sub.just = c(0.5, 1), category.names = names(x), force.unique = TRUE, print.mode = "raw", sigdigs = 3, direct.area = FALSE, area.vector = 0, hyper.test = FALSE, total.population = NULL, lower.tail = TRUE, ...) } \arguments{ \item{x}{A list of vectors (e.g., integers, chars), with each component corresponding to a separate circle in the Venn diagram} \item{filename}{Filename for image output, or if NULL returns the grid object itself} \item{disable.logging}{Boolean to disable log file output and print to console instead} \item{height}{Integer giving the height of the output figure in units} \item{width}{Integer giving the width of the output figure in units} \item{resolution}{Resolution of the final figure in DPI} \item{imagetype}{Specification of the image format (e.g. tiff, png or svg)} \item{units}{Size-units to use for the final figure} \item{compression}{What compression algorithm should be applied to the final tiff} \item{na}{Missing value handling method: "none", "stop", "remove"} \item{main}{Character giving the main title of the diagram} \item{sub}{Character giving the subtitle of the diagram} \item{main.pos}{Vector of length 2 indicating (x,y) of the main title} \item{main.fontface}{Character giving the fontface (font style) of the main title} \item{main.fontfamily}{Character giving the fontfamily (font type) of the main title} \item{main.col}{Character giving the colour of the main title} \item{main.cex}{Number giving the cex (font size) of the main title} \item{main.just}{Vector of length 2 indicating horizontal and vertical justification of the main title} \item{sub.pos}{Vector of length 2 indicating (x,y) of the subtitle} \item{sub.fontface}{Character giving the fontface (font style) of the subtitle} \item{sub.fontfamily}{Character giving the fontfamily (font type) of the subtitle} \item{sub.col}{Character Colour of the subtitle} \item{sub.cex}{Number giving the cex (font size) of the subtitle} \item{sub.just}{Vector of length 2 indicating horizontal and vertical justification of the subtitle} \item{category.names}{Allow specification of category names using plotmath syntax} \item{force.unique}{Logical specifying whether to use only unique elements in each item of the input list or use all elements. Defaults to FALSE} \item{print.mode}{Can be either 'raw' or 'percent'. This is the format that the numbers will be printed in. Can pass in a vector with the second element being printed under the first} \item{sigdigs}{If one of the elements in print.mode is 'percent', then this is how many significant digits will be kept} \item{direct.area}{If this is equal to true, then the vector passed into area.vector will be directly assigned to the areas of the corresponding regions. Only use this if you know which positions in the vector correspond to which regions in the diagram} \item{area.vector}{An argument to be used when direct.area is true. These are the areas of the corresponding regions in the Venn Diagram} \item{hyper.test}{If there are only two categories in the venn diagram and total.population is not NULL, then perform the hypergeometric test and add it to the sub title.} \item{total.population}{An argument to be used when hyper.test is true. This is the total population size} \item{lower.tail}{logical; if TRUE (default), probabilities are P[X <= x], otherwise, P[X > x]} \item{...}{A series of graphical parameters tweaking the plot. See below for details} } \details{ \tabular{cccl}{ \bold{Argument} \tab \bold{Venn Sizes} \tab \bold{Class} \tab \bold{Description}\cr \code{lwd} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the width of each circle's circumference\cr \code{lty} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the dash pattern of each circle's circumference\cr \code{col} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the colour of each circle's circumference\cr \code{fill} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the colour of each circle's area\cr \code{alpha} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the alpha transparency of each circle's area\cr \code{label.col} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the colour for each area label (length = \cr \tab \tab \tab 1/3/7/15 based on set-number)\cr \code{cex} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the size for each area label (length = \cr \tab \tab \tab 1/3/7/15 based on set-number)\cr \code{fontface} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the fontface for each area label (length = \cr \tab \tab \tab 1/3/7/15 based on set-number)\cr \code{fontfamily} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the fontfamily for each area label (length = \cr \tab \tab \tab 1/3/7/15 based on set-number)\cr \code{cat.pos} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the position (in degrees) of each category \cr \tab \tab \tab name along the circle, with 0 at 12 o'clock\cr \code{cat.dist} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the distance (in npc units) of each category\cr \tab \tab \tab name from the edge of the circle (can be negative)\cr \code{cat.cex} \tab 1,2,3,4,5 \tab \var{numeric} \tab Vector giving the size for each category name\cr \code{cat.col} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the colour for each category name\cr \code{cat.fontface} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the fontface for each category name\cr \code{cat.fontfamily} \tab 1,2,3,4,5 \tab \var{character} \tab Vector giving the fontfamily for each category name\cr \code{cat.just} \tab 1,2,3,4,5 \tab \var{numeric} \tab List (length = 1/2/3/4 based on set number) of Vectors\cr \tab \tab \tab of length 2 indicating horizontal and vertical justification\cr \tab \tab \tab for each category name\cr \code{cat.default.pos}\tab 1,2,3 \tab \var{character} \tab One of c('outer', 'text') to specify the default location\cr \tab \tab \tab of category names (cat.pos and cat.dist are handled differently)\cr \code{cat.prompts} \tab 2 \tab \var{numeric} \tab Boolean indicating whether to display help text on category\cr \tab \tab \tab name positioning or not\cr \code{margin} \tab 1,2,3,4,5 \tab \var{numeric} \tab Number giving the amount of whitespace around the diagram\cr \tab \tab \tab in grid units\cr\code{rotation.degree}\tab 1,2,3,4,5 \tab \var{numeric} \tab Number of degrees to rotate the entire diagram\cr \code{rotation.centre}\tab 1,2,3,4,5 \tab \var{numeric} \tab Vector of length 2 indicating (x,y) of the rotation\cr \tab \tab \tab centre\cr\code{rotation} \tab 3 \tab \var{numeric} \tab Number giving the clockwise rotation of a three-set Venn\cr \tab \tab \tab diagram (1, 2, or 3)\cr \code{reverse} \tab 3 \tab \var{logical} \tab Reflect the three-set Venn diagram along its central\cr \tab \tab \tab vertical axis of symmetry. Use in combination with \code{rotation}\cr \tab \tab \tab to generate all possible set orders\cr\code{euler.d} \tab 2, 3 \tab \var{logical} \tab Enable Euler diagrams for two-set and three-set Venn\cr \tab \tab \tab diagrams (Venn Diagrams with moveable circles)\cr \code{scaled} \tab 2, 3 \tab \var{logical} \tab Enable scaling for two-set and certain three-set Euler\cr \tab \tab \tab diagrams. (euler.d must be true to enable this)\cr \code{sep.dist} \tab 2, 3 \tab \var{numeric} \tab Controls the separation between distinct circles in\cr \tab \tab \tab certain two-set or three-set Euler diagrams.\cr \code{offset} \tab 2, 3 \tab \var{numeric} \tab Number between 0 and 1 giving the amount to offset the\cr \tab \tab \tab smaller circle by in the inclusion type of two-set Euler\cr \tab \tab \tab diagram and certain similar three-set Euler diagrams.\cr \code{inverted} \tab 2 \tab \var{logical} \tab Flip the two-set Venn diagram along its vertical\cr \tab \tab \tab axis (distinguished from \code{reverse})\cr \code{ext.text} \tab 2 \tab \var{logical} \tab Allow external text labels when areas are small\cr \code{ext.percent} \tab 2 \tab \var{numeric} \tab A vector (length 3) indicating the proportion that\cr \tab \tab \tab a partial area has to be smaller than to trigger externa\cr \tab \tab \tab l text placement. The elements allow for individual\cr \tab \tab \tab control of the areas in the order of the first area,\cr \tab \tab \tab second area and intersection area.\cr \code{ext.pos} \tab 2 \tab \var{numeric} \tab A vector (length 1 or 2) giving the positions (in degrees)\cr \tab \tab \tab of the external area labels along the\cr \tab \tab \tab circles, with 0 (default) at 12 o'clock\cr\code{ext.line.lwd} \tab 2 \tab \var{numeric} \tab Width of line connecting to \code{ext.text}\cr \code{ext.line.lty} \tab 2 \tab \var{numeric} \tab The dash pattern of the lines connecting the external\cr \tab \tab \tab area labels to their anchor points.\cr \code{ext.dist} \tab 2 \tab \var{numeric} \tab Vector of length 1 or 2 indicating length of external\cr \tab \tab \tab line (use negative values to shorten the line )\cr \code{ext.length} \tab 2 \tab \var{numeric} \tab Vector of length 1 or 2 indicating the proportion of\cr \tab \tab \tab the external line that is drawn from the anchor to the text\cr } } \value{Plots a figure to the file given by the \var{filename} argument.} \author{Hanbo Chen} \seealso{ \code{\link{draw.single.venn}}, \code{\link{draw.pairwise.venn}}, \code{\link{draw.triple.venn}}, \code{\link{draw.quad.venn}}, \code{\link{draw.quintuple.venn}} } \examples{ # Note: most examples are listed as dontrun to meet CRAN requirements, # but all should work as-is! # compact and minimal notation \dontrun{ venn.plot <- venn.diagram( list(A = 1:150, B = 121:170), filename = tempfile( pattern = 'Venn_2set_simple', fileext = '.tiff' ) ); venn.plot <- venn.diagram( list(A = 1:150, B = 121:170, C = 101:200), filename = tempfile( pattern = 'Venn_3set_simple', fileext = '.tiff' ) ); } # a more elaborate two-set Venn diagram with title and subtitle venn.plot <- venn.diagram( x = list( "A" = 1:100, "B" = 96:140 ), filename = tempfile( pattern = 'Venn_2set_complex', fileext = '.tiff' ), scaled = TRUE, ext.text = TRUE, ext.line.lwd = 2, ext.dist = -0.15, ext.length = 0.9, ext.pos = -4, inverted = TRUE, cex = 2.5, cat.cex = 2.5, rotation.degree = 45, main = "Complex Venn Diagram", sub = "Featuring: rotation and external lines", main.cex = 2, sub.cex = 1 ); \dontrun{ # sample three-set Euler diagram venn.plot <- venn.diagram( x = list( "Num A" = paste("Num", 1:100), "Num B" = c(paste("Num", 61:70), paste("Num", 71:100)), "Num C" = c(paste("Num", 41:60), paste("Num", 61:70))), euler.d = TRUE, filename = tempfile( pattern = 'Euler_3set_simple', fileext = '.tiff' ), cat.pos = c(-20, 0, 20), cat.dist = c(0.05, 0.05, 0.02), cex = 2.5, cat.cex = 2.5, reverse = TRUE ); # sample three-set Euler diagram venn.plot <- venn.diagram( x = list( A = c(1:10), B = c(11:90), C = c(81:90) ), euler.d = TRUE, filename = tempfile( pattern = 'Euler_3set_scaled', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = 0 ); } # sample four-set Venn Diagram A <- sample(1:1000, 400, replace = FALSE); B <- sample(1:1000, 600, replace = FALSE); C <- sample(1:1000, 350, replace = FALSE); D <- sample(1:1000, 550, replace = FALSE); E <- sample(1:1000, 375, replace = FALSE); venn.plot <- venn.diagram( x = list( A = A, D = D, B = B, C = C ), filename = tempfile( pattern = 'Venn_4set_pretty', fileext = '.tiff' ), col = "transparent", fill = c("cornflowerblue", "green", "yellow", "darkorchid1"), alpha = 0.50, label.col = c("orange", "white", "darkorchid4", "white", "white", "white", "white", "white", "darkblue", "white", "white", "white", "white", "darkgreen", "white"), cex = 1.5, fontfamily = "serif", fontface = "bold", cat.col = c("darkblue", "darkgreen", "orange", "darkorchid4"), cat.cex = 1.5, cat.pos = 0, cat.dist = 0.07, cat.fontfamily = "serif", rotation.degree = 270, margin = 0.2 ); # sample five-set Venn Diagram venn.plot <- venn.diagram( x = list( A = A, B = B, C = C, D = D, E = E ), filename = tempfile( pattern = 'Venn_5set_pretty', fileext = '.tiff' ), col = "black", fill = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"), alpha = 0.50, cex = c(1.5, 1.5, 1.5, 1.5, 1.5, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 1, 1, 1, 1, 1.5), cat.col = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"), cat.cex = 1.5, cat.fontface = "bold", margin = 0.05 ); # Complex three-way Venn with labels & sub-/super-scripts venn.plot <- venn.diagram( x = list( I = c(1:60, 61:105, 106:140, 141:160, 166:175, 176:180, 181:205, 206:220), II = c(531:605, 476:530, 336:375, 376:405, 181:205, 206:220, 166:175, 176:180), III = c(61:105, 106:140, 181:205, 206:220, 221:285, 286:335, 336:375, 376:405) ), category.names = c( expression( bold('A'['1: subscript']) ), expression( bold('B'^'2: going up') ), expression( paste(bold('C'^'3'), bold('X'['i' <= 'r'^'2']^'2') ) ) ), filename = tempfile( pattern = 'Fig3-1_triple_labels_sub_and_superscripts', fileext = '.tiff' ), output = TRUE, height = 3000, width = 3000, resolution = 300, compression = 'lzw', units = 'px', lwd = 6, lty = 'blank', fill = c('yellow', 'purple', 'green'), cex = 3.5, fontface = "bold", fontfamily = "sans", cat.cex = 3, cat.fontface = "bold", cat.default.pos = "outer", cat.pos = c(-27, 27, 135), cat.dist = c(0.055, 0.055, 0.085), cat.fontfamily = "sans", rotation = 1 ); # Complex 3-way Venn using expressions venn.plot <- venn.diagram( x = list( "Num A" = paste("Num", 1:100), "Num B" = c(paste("Num", 61:70), paste("Num", 71:100)), "Num C" = c(paste("Num", 41:60), paste("Num", 61:70))), category.names = c( expression( bold('A'['1']) ), expression( bold('A'['2']) ), expression( bold('A'['3']) ) ), euler.d = TRUE, filename = tempfile( pattern = 'Fig3-2_Euler_3set_simple_with_subscripts', fileext = '.tiff' ), cat.pos = c(-20, 0, 20), cat.dist = c(0.05, 0.05, 0.02), cex = 2.5, cat.cex = 2.5, reverse = TRUE ); \dontrun{ # Example to print to screen venn.plot <- venn.diagram( x = list( sample1 = c(1:40), sample2 = c(30:60) ), filename = NULL, disable.logging = TRUE ); # Save picture to non-TIFF file type # currently working on adding this functionality directly into venn.diagram venn.plot <- venn.diagram( x = list ( A = 1:10, B = 6:25 ), filename = NULL, disable.logging = TRUE ); jpeg(tempfile(pattern = 'venn_jpeg', fileext = '.jpg')); grid.draw(venn.plot); dev.off(); } #dontrun-starts-here ### NB: All figures from the paper can be run, but are turned off from ### automatic execution to reduce burden on CRAN computing resources. \dontrun{ # Figure 1A venn.plot <- venn.diagram( x = list( Label = 1:100 ), filename = tempfile( pattern = '1A-single_Venn', fileext = '.tiff' ), col = "black", lwd = 9, fontface = "bold", fill = "grey", alpha = 0.75, cex = 4, cat.cex = 3, cat.fontface = "bold", ); # Figure 1B venn.plot <- venn.diagram( x = list( X = 1:150, Y = 121:180 ), filename = tempfile( pattern = '1B-double_Venn', fileext = '.tiff' ), lwd = 4, fill = c("cornflowerblue", "darkorchid1"), alpha = 0.75, label.col = "white", cex = 4, fontfamily = "serif", fontface = "bold", cat.col = c("cornflowerblue", "darkorchid1"), cat.cex = 3, cat.fontfamily = "serif", cat.fontface = "bold", cat.dist = c(0.03, 0.03), cat.pos = c(-20, 14) ); # Figure 1C venn.plot <- venn.diagram( x = list( R = c(1:70, 71:110, 111:120, 121:140), B = c(141:200, 71:110, 111:120, 201:230), G = c(231:280, 111:120, 121:140, 201:230) ), filename = tempfile( pattern = '1C-triple_Venn', fileext = '.tiff' ), col = "transparent", fill = c("red", "blue", "green"), alpha = 0.5, label.col = c("darkred", "white", "darkblue", "white", "white", "white", "darkgreen"), cex = 2.5, fontfamily = "serif", fontface = "bold", cat.default.pos = "text", cat.col = c("darkred", "darkblue", "darkgreen"), cat.cex = 2.5, cat.fontfamily = "serif", cat.dist = c(0.06, 0.06, 0.03), cat.pos = 0 ); # Figure 1D venn.plot <- venn.diagram( x = list( I = c(1:60, 61:105, 106:140, 141:160, 166:175, 176:180, 181:205, 206:220), IV = c(531:605, 476:530, 336:375, 376:405, 181:205, 206:220, 166:175, 176:180), II = c(61:105, 106:140, 181:205, 206:220, 221:285, 286:335, 336:375, 376:405), III = c(406:475, 286:335, 106:140, 141:160, 166:175, 181:205, 336:375, 476:530) ), filename = tempfile( pattern = '1D-quadruple_Venn', fileext = '.tiff' ), col = "black", lty = "dotted", lwd = 4, fill = c("cornflowerblue", "green", "yellow", "darkorchid1"), alpha = 0.50, label.col = c("orange", "white", "darkorchid4", "white", "white", "white", "white", "white", "darkblue", "white", "white", "white", "white", "darkgreen", "white"), cex = 2.5, fontfamily = "serif", fontface = "bold", cat.col = c("darkblue", "darkgreen", "orange", "darkorchid4"), cat.cex = 2.5, cat.fontfamily = "serif" ); # Figure 2-1 venn.plot <- venn.diagram( x = list( A = 1:105, B = 101:115 ), filename = tempfile( pattern = '2-1_special_case_ext-text', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = c(-20, 20), ext.line.lty = "dotted", ext.line.lwd = 2, ext.pos = 12, ext.dist = -0.12, ext.length = 0.85 ); # Figure 2-2 venn.plot <- venn.diagram( x = list( A = 1:100, B = 1:10 ), filename = tempfile( pattern = '2-2_special_case_pairwise-inclusion', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = 0 ); # Figure 2-3 venn.plot <- venn.diagram( x = list( A = 1:150, B = 151:250 ), filename = tempfile( pattern = '2-3_special_case_pairwise-exclusion', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = c(0, 0), cat.dist = 0.05 ); # Figure 2-4 venn.plot <- venn.diagram( x = list( A = c(1:50, 101:140, 141:160, 161:170), B = c(171:230, 101:140, 161:170, 291:320), C = c(141:160, 161:170, 291:320) ), filename = tempfile( pattern = '2-4_triple_special_case-001', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.dist = c(0.05, 0.05, -0.1) ); # Figure 2-5 venn.plot <- venn.diagram( x = list( A = c(1:100), B = c(61:70, 71:100), C = c(41:60, 61:70) ), filename = tempfile( pattern = '2-5_triple_special_case-012AA', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = c(-25, 0, 30), cat.dist = c(0.05, 0.05, 0.02) ); # Figure 2-6 venn.plot <- venn.diagram( x = list( A = c(1:90), B = c(1:25), C = c(1:5) ), filename = tempfile( pattern = '2-6_triple_special_case-022AAAO', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = 0, cat.dist = c(0.03, 0.03, 0.01) ); # Figure 2-7 venn.plot <- venn.diagram( x = list( A = c(1:20), B = c(21:80), C = c(81:210) ), filename = tempfile( pattern = '2-7_triple_special_case-100', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.dist = 0.05 ); # Figure 2-8 venn.plot <- venn.diagram( x = list( A = c(1:80), B = c(41:150), C = c(71:100) ), filename = tempfile( pattern = '2-8_triple_special_case-011A', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.dist = c(0.07, 0.07, 0.02), cat.pos = c(-20, 20, 20) ); # Figure 2-9 venn.plot <- venn.diagram( x = list( A = c(1:10), B = c(11:90), C = c(81:90) ), filename = tempfile( pattern = '2-9_triple_special_case-121AO', fileext = '.tiff' ), cex = 2.5, cat.cex = 2.5, cat.pos = 0, cat.dist = c(0.04, 0.04, 0.02), reverse = TRUE ); #dontrun-ends-here } } \keyword{hplot} VennDiagram/man/make.truth.table.Rd0000755000176200001440000000066614221171123016664 0ustar liggesusers\name{make.truth.table} \alias{make.truth.table} \title{Make a truth table} \usage{ make.truth.table(x) } \arguments{ \item{x}{A short vector.} } \value{ A data frame with \code{length(x)} logical vector columns and \code{2 ^ length(x)} rows. } \description{ Makes a truth table of the inputs. } \examples{ \dontrun{make.truth.table(c(a = 1, b = 2, c = 3, d = 4))} } \author{ Richard Cotton } \seealso{ \code{\link[base]{expand.grid}} } VennDiagram/man/get.venn.partitions.Rd0000755000176200001440000000505214221171123017425 0ustar liggesusers\name{get.venn.partitions} \alias{get.venn.partitions} \title{Get the size of individual partitions in a Venn diagram} \usage{ get.venn.partitions(x, force.unique = TRUE, keep.elements = TRUE, hierarchical = FALSE) } \arguments{ \item{x}{A list of vectors.} \item{force.unique}{A logical value. Should only unique values be considered?} \item{keep.elements}{A logical value. Should the elements in each region be returned?} \item{hierarchical}{A logical value. Changed the way overlapping elements are treated if force.unique is TRUE.} } \value{ A data frame with \code{length(x)} columns and \code{2 ^ length(x)} rows. The first \code{length(x)} columns are all logical; see \code{\link{make.truth.table}} for more details. There are three additional columns: \describe{ \item{..set..}{A set theoretical desription of the Venn region. (Note that in some locales under Windows, the data.frame print method fails to correctly display the Unicode symbols for set union and set intersection. This is a bug in R, not this function.)} \item{..values..}{A vector of values contained in the Venn region. Not returned if keep.elements is FALSE.} \item{..count..}{An integer of the number of values in the Venn region.} } } \description{ Partitions a list into Venn regions. } \section{Details}{ If force.unique is FALSE, then there are two supported methods of grouping categories with duplicated elements in common. If hierarchical is FALSE, then any common elements are gathered into a pool. So if \code{x <- list(a = c(1,1,2,2,3,3), b=c(1,2,3,4,4,5), c=c(1,4))} then \code{(b intersect c)/(a)} would contain three 4's. Since the 4's are pooled, \code{(b)/(a union c)} contains no 4's. If hierachical is TRUE, then \code{(b intersect c)/(a)} would contain one 4.Then \code{(b)/(a union c)} cotains one 4. } \examples{ # Compare force.unique options x <- list(a = c(1, 1, 1, 2, 2, 3), b = c(2, 2, 2, 3, 4, 4)) get.venn.partitions(x) get.venn.partitions(x, force.unique = FALSE) # Figure 1D from ?venn.diagram xFig1d = list( I = c(1:60, 61:105, 106:140, 141:160, 166:175, 176:180, 181:205, 206:220), IV = c(531:605, 476:530, 336:375, 376:405, 181:205, 206:220, 166:175, 176:180), II = c(61:105, 106:140, 181:205, 206:220, 221:285, 286:335, 336:375, 376:405), III = c(406:475, 286:335, 106:140, 141:160, 166:175, 181:205, 336:375, 476:530) ) get.venn.partitions(xFig1d) grid.draw(VennDiagram::venn.diagram(x, NULL, disable.logging = TRUE)) } \author{ Richard Cotton. } \seealso{ \code{\link[VennDiagram]{venn.diagram}}, \code{\link{make.truth.table}} } VennDiagram/man/draw.sp.case.scaled.Rd0000644000176200001440000000113414112260207017223 0ustar liggesusers\name{draw.sp.case.scaled} \alias{draw.sp.case.scaled} \title{Draw a special Venn Diagram with Three Sets. These are the scaled cases} \description{Special case of draw.triple.venn. Internal use only.} \value{See draw.triple.venn} \author{Zhiyuan Wang} \examples{ venn.plot <- draw.triple.venn( area1 = 2, area2 = 1, area3 = 3, n12 = 1, n23 = 1, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ); dev.off(); } \keyword{ internal } VennDiagram/man/calculate.overlap.Rd0000755000176200001440000000156414112260207017117 0ustar liggesusers\name{calculate.overlap} \alias{calculate.overlap} \title{Calculate Overlap} \description{Determine the groupings of values as they would be presented in the venn diagram.} \usage{ calculate.overlap(x) } \arguments{ \item{x}{A list of vectors (e.g., integers, chars), with each component corresponding to a separate circle in the Venn diagram} } \details{ This function mostly complements the venn.diagram() function for the case where users want to know what values are grouped into the particular areas of the venn diagram. } \value{ Returns a list of lists which contain the values assigned to each of the areas of a venn diagram. } \author{Christopher Lalansingh} \examples{ # A simple single-set diagram cardiome <- letters[1:10] superset <- letters[8:24] overlap <- calculate.overlap( x = list( "Cardiome" = cardiome, "SuperSet" = superset ) ); } \keyword{hplot} VennDiagram/man/draw.single.venn.Rd0000644000176200001440000000671614221171123016675 0ustar liggesusers\name{draw.single.venn} \alias{draw.single.venn} \title{Draw a Venn Diagram with a Single Set} \description{Creates a Venn diagram with a single set.} \usage{ draw.single.venn(area, category = "", lwd = 2, lty = "solid", col = "black", fill = NULL, alpha = 0.5, label.col = "black", cex = 1, fontface = "plain", fontfamily = "serif", cat.pos = 0, cat.dist = 0.025, cat.cex = 1, cat.col = "black", cat.fontface = "plain", cat.fontfamily = "serif", cat.just = list(c(0.5, 0.5)), cat.default.pos = "outer", cat.prompts = FALSE, rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, ...) } \arguments{ \item{area}{The size of the set} \item{category}{The category name of the set} \item{lwd}{width of the circle's circumference} \item{lty}{dash pattern of the circle's circumference} \item{col}{Colour of the circle's circumference} \item{fill}{Colour of the circle's area} \item{alpha}{Alpha transparency of the circle's area} \item{label.col}{Colour of the area label} \item{cex}{size of the area label} \item{fontface}{fontface of the area label} \item{fontfamily}{fontfamily of the area label} \item{cat.pos}{The position (in degrees) of the category name along the circle, with 0 (default) at 12 o'clock} \item{cat.dist}{The distance (in npc units) of the category name from the edge of the circle (can be negative)} \item{cat.cex}{size of the category name} \item{cat.col}{Colour of the category name} \item{cat.fontface}{fontface of the category name} \item{cat.fontfamily}{fontfamily of the category name} \item{cat.just}{List of 1 vector of length 2 indicating horizontal and vertical justification of the category name} \item{cat.default.pos}{One of c('outer', 'text') to specify the default location of category names (cat.pos and cat.dist are handled differently)} \item{cat.prompts}{Boolean indicating whether to display help text on category name positioning or not)} \item{rotation.degree}{Number of degrees to rotate the entire diagram} \item{rotation.centre}{A vector (length 2) indicating (x,y) of the rotation centre} \item{ind}{Boolean indicating whether the function is to automatically draw the diagram in the end or not} \item{...}{Additional arguments to be passed, including \code{margin}, which indicates amount of whitespace around the final diagram in npc units} } \details{ This function mostly complements other functions in the VennDiagram package that draws multi-set diagrams by providing a function that draws single-set diagrams with similar graphical options. } \value{ Returns an object of class gList containing the grid objects that make up the diagram. Also displays the diagram in a graphical device unless specified with ind = FALSE. Grid::grid.draw can be used to draw the gList object in a graphical device. } \author{Hanbo Chen} \examples{ # A simple single-set diagram venn.plot <- draw.single.venn(100, "First"); grid.draw(venn.plot); grid.newpage(); # A more complicated diagram venn.plot <- draw.single.venn( area = 365, category = "All\nDays", lwd = 5, lty = "blank", cex = 3, label.col = "orange", cat.cex = 4, cat.pos = 180, cat.dist = -0.20, cat.col = "white", fill = "red", alpha = 0.15 ); grid.draw(venn.plot); grid.newpage(); # Writing to file tiff( filename = tempfile( pattern = 'Single_Venn_diagram', fileext = '.tiff' ), compression = "lzw" ); venn.plot <- draw.single.venn(100, "First", ind = FALSE); grid.draw(venn.plot); dev.off(); } \keyword{hplot} VennDiagram/man/draw.triple.venn.Rd0000644000176200001440000001575714221171123016720 0ustar liggesusers\name{draw.triple.venn} \alias{draw.triple.venn} \title{Draw a Venn Diagram with Three Sets} \description{Creates a Venn diagram with three sets. Creates Euler diagrams when the dataset meets certain conditions.} \usage{ draw.triple.venn(area1, area2, area3, n12, n23, n13, n123, category = rep("", 3), rotation = 1, reverse = FALSE, euler.d = TRUE, scaled = TRUE, lwd = rep(2, 3), lty = rep("solid", 3), col = rep("black", 3), fill = NULL, alpha = rep(0.5, 3), label.col = rep("black", 7), cex = rep(1, 7), fontface = rep("plain", 7), fontfamily = rep("serif", 7), cat.pos = c(-40, 40, 180), cat.dist = c(0.05, 0.05, 0.025), cat.col = rep("black", 3), cat.cex = rep(1, 3), cat.fontface = rep("plain", 3), cat.fontfamily = rep("serif", 3), cat.just = list(c(0.5, 1), c(0.5, 1), c(0.5, 0)), cat.default.pos = "outer", cat.prompts = FALSE, rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, sep.dist = 0.05, offset = 0, cex.prop = NULL, print.mode = "raw", sigdigs = 3, direct.area = FALSE, area.vector = 0, ...) } \arguments{ \item{area1}{The size of the first set} \item{area2}{The size of the second set} \item{area3}{The size of the third set} \item{n12}{The size of the intersection between the first and the second set} \item{n23}{The size of the intersection between the second and the third set} \item{n13}{The size of the intersection between the first and the third set} \item{n123}{The size of the intersection between all three sets} \item{category}{A vector (length 3) of strings giving the category names of the sets} \item{rotation}{1 (default), 2, or 3 indicating clockwise rotation of the three sets from the default arrangement} \item{reverse}{Boolean indicating whether the diagram should be mirrored long the vertical axis or not} \item{euler.d}{Boolean indicating whether to draw Euler diagrams when conditions are met or not (Venn Diagrams with moveable circles)} \item{scaled}{Boolean indicating whether to scale circle sizes in certain Euler diagrams according to set sizes or not (euler.d must be true to enable this)} \item{lwd}{A vector (length 3) of numbers giving the width of the circles' circumferences} \item{lty}{A vector (length 3) giving the dash pattern of the circles' circumferences} \item{col}{A vector (length 3) giving the colours of the circles' circumferences} \item{fill}{A vector (length 3) giving the colours of the circles' areas} \item{alpha}{A vector (length 3) giving the alpha transparency of the circles' areas} \item{label.col}{A vector (length 7) giving the colours of the areas' labels} \item{cex}{A vector (length 7) giving the size of the areas' labels} \item{fontface}{A vector (length 7) giving the fontface of the areas' labels} \item{fontfamily}{A vector (length 7) giving the fontfamily of the areas' labels} \item{cat.pos}{A vector (length 3) giving the positions (in degrees) of the category names along the circles, with 0 (default) at 12 o'clock} \item{cat.dist}{A vector (length 3) giving the distances (in npc units) of the category names from the edges of the circles (can be negative)} \item{cat.cex}{A vector (length 3) giving the size of the category names} \item{cat.col}{A vector (length 3) giving the colours of the category names} \item{cat.fontface}{A vector (length 3) giving the fontface of the category names} \item{cat.fontfamily}{A vector (length 3) giving the fontfamily of the category names} \item{cat.just}{List of 3 vectors of length 2 indicating horizontal and vertical justification of each category name} \item{cat.default.pos}{One of c('outer', 'text') to specify the default location of category names (cat.pos and cat.dist are handled differently)} \item{cat.prompts}{Boolean indicating whether to display help text on category name positioning or not)} \item{rotation.degree}{Number of degrees to rotate the entire diagram} \item{rotation.centre}{A vector (length 2) indicating (x,y) of the rotation centre} \item{ind}{Boolean indicating whether the function is to automatically draw the diagram before returning the gList object or not} \item{sep.dist}{Number between 0 and 1 giving the distance between circles in certain Euler diagrams with mutually exclusive sets} \item{offset}{Number giving the amount of offset from the centre in certain Euler diagrams with inclusive sets} \item{cex.prop}{A function or string used to rescale areas} \item{print.mode}{Can be either 'raw' or 'percent'. This is the format that the numbers will be printed in. Can pass in a vector with the second element being printed under the first} \item{sigdigs}{If one of the elements in print.mode is 'percent', then this is how many significant digits will be kept} \item{direct.area}{If this is equal to true, then the vector passed into area.vector will be directly assigned to the areas of the corresponding regions. Only use this if you know which positions in the vector correspond to which regions in the diagram} \item{area.vector}{An argument to be used when direct.area is true. These are the areas of the corresponding regions in the Venn Diagram} \item{...}{Additional arguments to be passed, including \code{margin}, which indicates amount of whitespace around the final diagram in npc units} } \details{ Euler diagrams are drawn for 19 special cases if \code{euler.d == TRUE}. Certain Euler diagrams make use of the \code{scaled}, \code{sep.dist}, or \code{offset} arguments specific to two-set Venn diagrams where appropriate. The function defaults to placing the three circles in a triangular arrangement with two sets on top and one set below. The circles correspond to area1, area2 and area3 in a clockwise fashion with area1 on the top left. N.B. General scaling for three-set Venn diagrams are disabled due to potentially misleading visual representation of the data. To re-enable, assign any value to variable \code{overrideTriple}. } \value{ Returns an object of class gList containing the grid objects that make up the diagram. Also displays the diagram in a graphical device unless specified with ind = FALSE. Grid::grid.draw can be used to draw the gList object in a graphical device. } \author{Hanbo Chen} \examples{ # A simple three-set diagram venn.plot <- draw.triple.venn(65, 75, 85, 35, 15, 25, 5, c("First", "Second", "Third")); grid.draw(venn.plot); grid.newpage(); # A more complicated diagram venn.plot <- draw.triple.venn( area1 = 65, area2 = 75, area3 = 85, n12 = 35, n23 = 15, n13 = 25, n123 = 5, category = c("First", "Second", "Third"), fill = c("blue", "red", "green"), lty = "blank", cex = 2, cat.cex = 2, cat.col = c("blue", "red", "green") ); grid.draw(venn.plot); grid.newpage(); # Demonstrating an Euler diagram venn.plot <- draw.triple.venn(20, 40, 60, 0, 0, 0, 0, c("First", "Second", "Third"), sep.dist = 0.1, rotation.degree = 30); # Writing to file tiff( filename = tempfile( pattern = 'Triple_Venn_diagram', fileext = '.tiff' ), compression = "lzw" ); grid.draw(venn.plot); dev.off(); } \keyword{hplot} VennDiagram/man/VennDiagram-internal.Rd0000644000176200001440000000134214112260207017507 0ustar liggesusers\name{VennDiagram-internal} %% Internal functions not intended to be exposed. Some of these are %% potentially useful/generalizable grid utility functions that might %% be exported in the future. %% \alias{adjust.venn} \alias{circle} \alias{add.title} \alias{decide.special.case} \alias{draw.sp.case} \alias{ell2poly} \alias{ellipse} \alias{find.cat.pos} \alias{find.dist} \alias{find.intersect} \alias{flip.venn} \alias{rotate} \alias{rotate.sp} \alias{rotate.venn.degrees} %% \title{Internal VennDiagram Functions} \description{ Internal VennDiagram functions } \details{ These are not to be called by the user (or in some cases are just waiting for proper documentation to be written :) } \keyword{ internal } VennDiagram/man/draw.quad.venn.Rd0000644000176200001440000001370314221171123016340 0ustar liggesusers\name{draw.quad.venn} \alias{draw.quad.venn} \title{Draw a Venn Diagram with Four Sets} \description{Creates a Venn diagram with four sets.} \usage{ draw.quad.venn(area1, area2, area3, area4, n12, n13, n14, n23, n24, n34, n123, n124, n134, n234, n1234, category = rep("", 4), lwd = rep(2, 4), lty = rep("solid", 4), col = rep("black", 4), fill = NULL, alpha = rep(0.5, 4), label.col = rep("black", 15), cex = rep(1, 15), fontface = rep("plain", 15), fontfamily = rep("serif", 15), cat.pos = c(-15, 15, 0, 0), cat.dist = c(0.22, 0.22, 0.11, 0.11), cat.col = rep("black", 4), cat.cex = rep(1, 4), cat.fontface = rep("plain", 4), cat.fontfamily = rep("serif", 4), cat.just = rep(list(c(0.5, 0.5)), 4), rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, cex.prop = NULL, print.mode = "raw", sigdigs = 3, direct.area = FALSE, area.vector = 0, ...) } \arguments{ \item{area1}{The size of the first set} \item{area2}{The size of the second set} \item{area3}{The size of the third set} \item{area4}{The size of the fourth set} \item{n12}{The size of the intersection between the first and the second set} \item{n13}{The size of the intersection between the first and the third set} \item{n14}{The size of the intersection between the first and the fourth set} \item{n23}{The size of the intersection between the second and the third set} \item{n24}{The size of the intersection between the second and the fourth set} \item{n34}{The size of the intersection between the third and the fourth set} \item{n123}{The size of the intersection between the first, second and third sets} \item{n124}{The size of the intersection between the first, second and fourth sets} \item{n134}{The size of the intersection between the first, third and fourth sets} \item{n234}{The size of the intersection between the second, third and fourth sets} \item{n1234}{The size of the intersection between all four sets} \item{category}{A vector (length 4) of strings giving the category names of the sets} \item{lwd}{A vector (length 4) of numbers giving the line width of the circles' circumferences} \item{lty}{A vector (length 4) giving the dash pattern of the circles' circumferences} \item{col}{A vector (length 4) giving the colours of the circles' circumferences} \item{fill}{A vector (length 4) giving the colours of the circles' areas} \item{alpha}{A vector (length 4) giving the alpha transparency of the circles' areas} \item{label.col}{A vector (length 15) giving the colours of the areas' labels} \item{cex}{A vector (length 15) giving the size of the areas' labels} \item{fontface}{A vector (length 15) giving the fontface of the areas' labels} \item{fontfamily}{A vector (length 15) giving the fontfamily of the areas' labels} \item{cat.pos}{A vector (length 4) giving the positions (in degrees) of the category names along the circles, with 0 (default) at 12 o'clock} \item{cat.dist}{A vector (length 4) giving the distances (in npc units) of the category names from the edges of the circles (can be negative)} \item{cat.cex}{A vector (length 4) giving the size of the category names} \item{cat.col}{A vector (length 4) giving the colours of the category names} \item{cat.fontface}{A vector (length 4) giving the fontface of the category names} \item{cat.fontfamily}{A vector (length 4) giving the fontfamily of the category names} \item{cat.just}{List of 4 vectors of length 2 indicating horizontal and vertical justification of each category name} \item{rotation.degree}{Number of degrees to rotate the entire diagram} \item{rotation.centre}{A vector (length 2) indicating (x,y) of the rotation centre} \item{ind}{Boolean indicating whether the function is to automatically draw the diagram before returning the gList object or not} \item{cex.prop}{A function or string used to rescale areas} \item{print.mode}{Can be either 'raw' or 'percent'. This is the format that the numbers will be printed in. Can pass in a vector with the second element being printed under the first} \item{sigdigs}{If one of the elements in print.mode is 'percent', then this is how many significant digits will be kept} \item{direct.area}{If this is equal to true, then the vector passed into area.vector will be directly assigned to the areas of the corresponding regions. Only use this if you know which positions in the vector correspond to which regions in the diagram} \item{area.vector}{An argument to be used when direct.area is true. These are the areas of the corresponding regions in the Venn Diagram} \item{...}{Additional arguments to be passed, including \code{margin}, which indicates amount of whitespace around the final diagram in npc units} } \details{ The function defaults to placing the ellipses so that area1 corresponds to lower left, area2 corresponds to lower right, area3 corresponds to middle left and area4 corresponds to middle right. Refer to the example below to see how the 31 partial areas are ordered. Arguments with length of 15 (label.col, cex, fontface, fontfamily) will follow the order in the example. } \value{ Returns an object of class gList containing the grid objects that make up the diagram. Also displays the diagram in a graphical device unless specified with ind = FALSE. Grid::grid.draw can be used to draw the gList object in a graphical device. } \author{Hanbo Chen} \examples{ # Reference four-set diagram venn.plot <- draw.quad.venn( area1 = 72, area2 = 86, area3 = 50, area4 = 52, n12 = 44, n13 = 27, n14 = 32, n23 = 38, n24 = 32, n34 = 20, n123 = 18, n124 = 17, n134 = 11, n234 = 13, n1234 = 6, category = c("First", "Second", "Third", "Fourth"), fill = c("orange", "red", "green", "blue"), lty = "dashed", cex = 2, cat.cex = 2, cat.col = c("orange", "red", "green", "blue") ); # Writing to file tiff( filename = tempfile( pattern = 'Quad_Venn_diagram', fileext = '.tiff' ), compression = "lzw" ); grid.draw(venn.plot); dev.off(); } \keyword{hplot} VennDiagram/man/draw.pairwise.venn.Rd0000644000176200001440000001665114221171123017236 0ustar liggesusers\name{draw.pairwise.venn} \alias{draw.pairwise.venn} \title{Draw a Venn Diagram with Two Sets} \description{Creates a Venn diagram with two sets. Creates Euler diagrams when the dataset meets certain conditions.} \usage{ draw.pairwise.venn(area1, area2, cross.area, category = rep("", 2), euler.d = TRUE, scaled = TRUE, inverted = FALSE, ext.text = TRUE, ext.percent = rep(0.05, 3), lwd = rep(2, 2), lty = rep("solid", 2), col = rep("black", 2), fill = NULL, alpha = rep(0.5, 2), label.col = rep("black", 3), cex = rep(1, 3), fontface = rep("plain", 3), fontfamily = rep("serif", 3), cat.pos = c(-50, 50), cat.dist = rep(0.025, 2), cat.cex = rep(1, 2), cat.col = rep("black", 2), cat.fontface = rep("plain", 2), cat.fontfamily = rep("serif", 2), cat.just = rep(list(c(0.5, 0.5)), 2), cat.default.pos = "outer", cat.prompts = FALSE, ext.pos = rep(0, 2), ext.dist = rep(0, 2), ext.line.lty = "solid", ext.length = rep(0.95, 2), ext.line.lwd = 1, rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, sep.dist = 0.05, offset = 0, cex.prop = NULL, print.mode = "raw", sigdigs = 3, ...) } \arguments{ \item{area1}{The size of the first set} \item{area2}{The size of the second set} \item{cross.area}{The size of the intersection between the sets} \item{category}{A vector (length 2) of strings giving the category names of the sets} \item{euler.d}{Boolean indicating whether to draw Euler diagrams when conditions are met or not (Venn Diagrams with moveable circles)} \item{scaled}{Boolean indicating whether to scale circle sizes in the diagram according to set sizes or not (euler.d must be true to enable this)} \item{inverted}{Boolean indicating whether the diagram should be mirrored long the vertical axis or not} \item{ext.text}{Boolean indicating whether to place area labels outside the circles in case of small partial areas or not} \item{ext.percent}{A vector (length 3) indicating the proportion that a partial area has to be smaller than to trigger external text placement. The elements allow for individual control of the areas in the order of area1, area2 and intersect area.} \item{lwd}{A vector (length 2) of numbers giving the line width of the circles' circumferences} \item{lty}{A vector (length 2) giving the line dash pattern of the circles' circumferences} \item{col}{A vector (length 2) giving the colours of the circles' circumferences} \item{fill}{A vector (length 2) giving the colours of the circles' areas} \item{alpha}{A vector (length 2) giving the alpha transparency of the circles' areas} \item{label.col}{A vector (length 3) giving the colours of the areas' labels} \item{cex}{A vector (length 3) giving the size of the areas' labels} \item{fontface}{A vector (length 3) giving the fontface of the areas' labels} \item{fontfamily}{A vector (length 3) giving the fontfamily of the areas' labels} \item{cat.pos}{A vector (length 2) giving the positions (in degrees) of the category names along the circles, with 0 (default) at the 12 o'clock location} \item{cat.dist}{A vector (length 2) giving the distances (in npc units) of the category names from the edges of the circles (can be negative)} \item{cat.cex}{A vector (length 2) giving the size of the category names} \item{cat.col}{A vector (length 2) giving the colours of the category names} \item{cat.fontface}{A vector (length 2) giving the fontface of the category names} \item{cat.fontfamily}{A vector (length 2) giving the fontfamily of the category names} \item{cat.just}{List of 2 vectors of length 2 indicating horizontal and vertical justification of each category name} \item{cat.default.pos}{One of c('outer', 'text') to specify the default location of category names (cat.pos and cat.dist are handled differently)} \item{cat.prompts}{Boolean indicating whether to display help text on category name positioning or not)} \item{ext.pos}{A vector (length 1 or 2) giving the positions (in degrees) of the external area labels along the circles, with 0 (default) at 12 o'clock} \item{ext.dist}{A vector (length 1 or 2) giving how far to place the external area labels relative to its anchor point} \item{ext.line.lty}{A vector (length 1 or 2) giving the dash pattern of the lines connecting the external area labels to their anchor points} \item{ext.length}{A vector (length 1 or 2) giving the proportion of the lines connecting the external area labels to their anchor points actually drawn} \item{ext.line.lwd}{A vector (length 1 or 2) giving the width of the lines connecting the external area labels to their anchor points} \item{rotation.degree}{Number of degrees to rotate the entire diagram} \item{rotation.centre}{A vector (length 2) indicating (x,y) of the rotation centre} \item{ind}{Boolean indicating whether the function is to automatically draw the diagram before returning the gList object or not} \item{sep.dist}{Number giving the distance between circles in case of an Euler diagram showing mutually exclusive sets} \item{offset}{Number between 0 and 1 giving the amount of offset from the centre in case of an Euler diagram showing inclusive sets} \item{cex.prop}{A function or string used to rescale areas} \item{print.mode}{Can be either 'raw' or 'percent'. This is the format that the numbers will be printed in. Can pass in a vector with the second element being printed under the first} \item{sigdigs}{If one of the elements in print.mode is 'percent', then this is how many significant digits will be kept} \item{...}{Additional arguments to be passed, including \code{margin}, which indicates amount of whitespace around the final diagram in npc units} } \details{ Euler diagrams are drawn for mutually exclusive sets (\code{cross.area == 0}), inclusive sets (\code{area1 == 0} or \code{area2 == 0}), and coincidental sets (\code{area1 == 0} and \code{area2 == 0)} if \code{euler.d == TRUE}. The function defaults to placing the larger set on the left. \code{inverted} or \code{rotation.degree} can be used to reverse this. } \value{ Returns an object of class gList containing the grid objects that make up the diagram. Also displays the diagram in a graphical device unless specified with ind = FALSE. Grid::grid.draw can be used to draw the gList object in a graphical device. } \author{Hanbo Chen} \examples{ # A simple two-set diagram venn.plot <- draw.pairwise.venn(100, 70, 30, c("First", "Second")); grid.draw(venn.plot); grid.newpage(); # Same diagram as above, but without scaling venn.plot <- draw.pairwise.venn(100, 70, 30, c("First", "Second"), scaled = FALSE); grid.draw(venn.plot); grid.newpage(); # A more complicated diagram Demonstrating external area labels venn.plot <- draw.pairwise.venn( area1 = 100, area2 = 70, cross.area = 68, category = c("First", "Second"), fill = c("blue", "red"), lty = "blank", cex = 2, cat.cex = 2, cat.pos = c(285, 105), cat.dist = 0.09, cat.just = list(c(-1, -1), c(1, 1)), ext.pos = 30, ext.dist = -0.05, ext.length = 0.85, ext.line.lwd = 2, ext.line.lty = "dashed" ); grid.draw(venn.plot); grid.newpage(); # Demonstrating an Euler diagram venn.plot <- draw.pairwise.venn( area1 = 100, area2 = 70, cross.area = 0, category = c("First", "Second"), cat.pos = c(0, 180), euler.d = TRUE, sep.dist = 0.03, rotation.degree = 45 ); # Writing to file tiff( filename = tempfile( pattern = 'Pairwise_Venn_diagram', fileext = '.tiff' ), compression = "lzw"); grid.draw(venn.plot); dev.off(); } \keyword{hplot} VennDiagram/TODO0000755000176200001440000000144014112260207013132 0ustar liggesusersKnown Bugs: * having an expression in the category names prints, but is left aligned with multiple lines instead of centred Improvements to make: * COMMENT COMMENT COMMENT * Structure the various functions so that they have identical parameter structures where possible * Move away from scalars for areas and convert everything, where possible, to vectors and lists * Add functionality into the venn.diagram function so that it will save in a specific file type given an appropriate file extension (BoutrosLab.plotting.general has a good solution) * There may be a non-unique solution to the triple-Venn scaling problem as implemented in Vennerable (https://r-forge.r-project.org/projects/vennerable/) * Weirdness in venn.diagram help in the PDF version with lack of wrapping in the parameter-table VennDiagram/DESCRIPTION0000644000176200001440000000120314225406014014145 0ustar liggesusersPackage: VennDiagram Version: 1.7.3 Type: Package Title: Generate High-Resolution Venn and Euler Plots Date: 2022-04-11 Author: Hanbo Chen Maintainer: Paul Boutros Imports: methods Depends: R (>= 3.5.0), grid (>= 2.14.1), futile.logger Description: A set of functions to generate high-resolution Venn and Euler plots. Includes handling for several special cases, including two-case scaling, and extensive customization of plot shape and structure. License: GPL-2 LazyLoad: yes Suggests: testthat NeedsCompilation: no Packaged: 2022-04-12 00:04:33 UTC; root Repository: CRAN Date/Publication: 2022-04-12 23:32:28 UTC VennDiagram/tests/0000755000176200001440000000000014221171123013601 5ustar liggesusersVennDiagram/tests/test-all.R0000644000176200001440000000021514221171123015447 0ustar liggesuserslibrary(testthat); library(VennDiagram); test_check('VennDiagram');#This should only be used in /tests/test-all.R, and is run by R CMD check VennDiagram/tests/testthat/0000755000176200001440000000000014225141021015437 5ustar liggesusersVennDiagram/tests/testthat/test-Log.R0000644000176200001440000000072514221171123017266 0ustar liggesusers#Testing using package testthat for detailed error messages library(testthat) #Suppress plotting for sanity options(device = pdf()); test_that( 'Disabled log file export', { disabled.output <- capture_output( venn.diagram( list(A = 1:20, B = 11:30), filename = NULL, disable.logging = TRUE ) ); expect_gt(nchar(disabled.output), 0); } ); VennDiagram/tests/testthat/test-Five.R0000644000176200001440000000343214221171123017434 0ustar liggesusers#Testing using package testthat for detailed error messages library(testthat) #Get the testing function applied to compare the two venn diagram objects source('testFunction.R'); #load in the reference plot data load('data/plotsFive.rda'); #Suppress plotting for sanity options(device=pdf(file = NULL)); #initialize the testing list of venn diagrams venn.test <- list(); #Colour venn.test <- c(venn.test,list(draw.quintuple.venn( area1 = 301, area2 = 321, area3 = 311, area4 = 321, area5 = 301, n12 = 188, n13 = 191, n14 = 184, n15 = 177, n23 = 194, n24 = 197, n25 = 190, n34 = 190, n35 = 173, n45 = 186, n123 = 112, n124 = 108, n125 = 108, n134 = 111, n135 = 104, n145 = 104, n234 = 111, n235 = 107, n245 = 110, n345 = 100, n1234 = 61, n1235 = 60, n1245 = 59, n1345 = 58, n2345 = 57, n12345 = 31, category = c('A', 'B', 'C', 'D', 'E'), fill = c('dodgerblue', 'goldenrod1', 'darkorange1', 'seagreen3', 'orchid3'), cat.col = c('dodgerblue', 'goldenrod1', 'darkorange1', 'seagreen3', 'orchid3'), cat.cex = 2, margin = 0.05, cex = c(1.5, 1.5, 1.5, 1.5, 1.5, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 1, 1, 1, 1, 1.5), ind = TRUE ))) venn.test <- prepare.test.cases(venn.test); testNames <- c('colour'); #Loop over all of the test cases for (i in 1:length(venn.test)) { test_that( paste('Case',testNames[i],'of five categories'), { for (j in 1:length(venn.test[[i]])) { expect_true( is_identical_without_name( venn.test[[i]][[j]], venn.plot[[i]][[j]], maxLength=3 ) ); } } ); } VennDiagram/tests/testthat/test-Four.R0000644000176200001440000000247514221171123017464 0ustar liggesusers#Testing using package testthat for detailed error messages library(testthat) #Get the testing function applied to compare the two venn diagram objects source('testFunction.R'); #load in the reference plot data load('data/plotsFour.rda'); #Suppress plotting for sanity options(device=pdf(file = NULL)); #initialize the testing list of venn diagrams venn.test <- list(); #Colour venn.test <- c(venn.test,list(draw.quad.venn( area1 = 72, area2 = 86, area3 = 50, area4 = 52, n12 = 44, n13 = 27, n14 = 32, n23 = 38, n24 = 32, n34 = 20, n123 = 18, n124 = 17, n134 = 11, n234 = 13, n1234 = 6, category = c('First', 'Second', 'Third', 'Fourth'), fill = c('orange', 'red', 'green', 'blue'), lty = 'dashed', cex = 2, cat.cex = 2, cat.col = c('orange', 'red', 'green', 'blue') ))) venn.test <- prepare.test.cases(venn.test); testNames <- c('colour'); #Loop over all of the test cases for (i in 1:length(venn.test)) { test_that( paste('Case',testNames[i],'of four categories'), { for (j in 1:length(venn.test[[i]])) { expect_true( is_identical_without_name( venn.test[[i]][[j]], venn.plot[[i]][[j]], maxLength=3 ) ); } } ); } VennDiagram/tests/testthat/test-One.R0000644000176200001440000000232714221171123017266 0ustar liggesusers#Testing using package testthat for detailed error messages library(testthat) #Get the testing function applied to compare the two venn diagram objects source('testFunction.R'); #load in the reference plot data load('data/plotsOne.rda'); #Suppress plotting for sanity options(device=pdf(file = NULL)); #initialize the testing list of venn diagrams venn.test <- list(); #Simple venn.test <- c(venn.test,list(draw.single.venn(100, 'First'))) #Colour and Labeled venn.test <- c(venn.test,list(draw.single.venn( area = 365, category = 'All\nDays', lwd = 5, lty = 'blank', cex = 3, label.col = 'orange', cat.cex = 4, cat.pos = 180, cat.dist = -0.20, cat.col = 'white', fill = 'red', alpha = 0.15 ))) venn.test <- prepare.test.cases(venn.test); testNames <- c('simple','colour'); #Loop over all of the test cases for (i in 1:length(venn.test)) { test_that( paste('Case', testNames[i], 'of one category'), { for (j in 1:length(venn.test[[i]])) { expect_true( is_identical_without_name( venn.test[[i]][[j]], venn.plot[[i]][[j]], maxLength=3 ) ); } } ); } VennDiagram/tests/testthat/data/0000755000176200001440000000000014221171123016352 5ustar liggesusersVennDiagram/tests/testthat/data/plotsFour.rda0000644000176200001440000000253514221171123021044 0ustar liggesusershT_ze`P/ĝ]׵` aTE]4%S(ꊠeCD:nΊvWך\^dn^~}?wIå/5Da muݠh h%( ε@X_`#k| m{ +Jx^c]^F=x 0B6EDXY. 긹xA@P,p 2(| %dd|eTZrm3 ?On~+x6WY9"We+xL?keeIT^2D k3nkz"fLϚ[Q>W w=(._D[% +FaT3J*0DYBc)d^ՄjgF$Н֐UvL@4HɚP%̠08" \ohouD飭VGtYDvUI$!dMdMHIҐh3;,*xEվH:ƈ̎fHAK:x/==z z&xx)JE{mk0ef+̋y @5"k3! !7F1l֜~s/SfDU!F~(~=^}{{)N411=ipFQWQ۾ʜ1U0:l=OEXʼfPelQx7P b DGsa^%4 4 D--QسNɶCc)ΘT!srgsQH̒f͵%ܹ[r}\hF_M"#3Ԍ݌G?yyO5#fܹqb?s͟XԌюsnw-L׌KA7:^gާNȌ.jF͸݌^cpr~gflf݌q8?qfK ҌnjF͸݌wiF5#f܆sn{g1e|*ѹt3s7wRC}f}_)AqΝ=yө Ҍ85#f܍sq^hul4A7;w3ʙ|^f{ fpxx-G8İyYC?[_so qՒAu;񄉤U-1ʔRyf$1 mݭs޴?IN]xcgm^'~$T/*} qϛS0VDyZ?e#=OJZR/G9q0 PVennDiagram/tests/testthat/data/plotsFive.rda0000644000176200001440000000412314221171123021015 0ustar liggesusers p g7 mzz$HRe-Sm.^"QmF !jCSj`PJ"$Iji1Szv=J5/3gww$SpR0AZBqw1M<^C:"5 ʠvf G3 9$`Vn k]㝈0 4b)/O|.e;Lp}='vD5(֖ʈp24ixך)L!lS Fx-~ Bɔ'-MI焾ק.d,h] }iNS LҤ`Y ܹxJt[ Nڌ/q$^!3Qa30ȝ\P޸p͸Ҵ:t1̌+a30#!můؙ!1iK dF43nFg;i3ή`zu׌J[h=- 2 BڌKZחz%P;cFt3nFW;i3t/)!3񘁮f\7#\3Nw`{,Bfv3BA͸Ұ0h+KV2Ca !Sອ7g\3-Xy'!3k@TQ#lf@͸{5R͏D 5pmیExk͈CvYU\3.8?E 5pLN5pBfma"-[2Ca D5f `F,ȝ狃׌Mͯkr'mFSOG5BȌlr'eUSJހkƙe;_3"°j7cȝ#.okFI!d8g 3%ga}k釹}vD#ܽ{Qp8yCŔ/ -r!_X2n(+KK5:Z/~)O6WiO.Ke>)JRwы1_7 {=\w߽@(@ szwюF!__e^}q VU̡/G \nq޸"r1gqNrVennDiagram/tests/testthat/data/plotsTwo.rda0000644000176200001440000000312114221171123020672 0ustar liggesusers[[lTv;[mTl< .4B X#mC ʊE'qSla t1^ࡓTӶr+V(6 ڤرoqq8Rcby1#%"Fvg ;`8旎^eZK_=3XX01SlrkrO: ,M j$I֛ )IP!A!VH4*3SxZ C)1-ɖRP%|[Pz4cQBBUQ>o)jq6wg;9tg^-TGlDm+Eu3#f9gDdȓ -bEp {&8,f0_v #hqZ{Sv~`T'TCyMY.qRsUթ~@;Vm0uX22j.1 j[T ;zLj(;-y<} <4G5`\H%^xilQNY%WS#N#`5j 3 IUcIotrIv .qFX8`" H,ß퉴kx%[&T+RT[6y@1 Wª[53c\F020w1dVz~ugdB|:ձ CW^[ٙN=#c ;Sũ,;d8Cayڅ`5DKԹTGEzSes}u=;>9V֪V6cq%Al]r&BmHH1GGѷn\}Nb}gόٓ+~X.3~?i"fC! 0ç:S֙w7D_)C d՗$?TY+.yno!rv}VOf;. ,C{55Bg%eh^|p!]x`?`A6 Gw۰hHd-Qd *͕,Y$Y)<_~T;0hbyL32zkn r=379ϣ}6e2F0>.fjnF>UO&|kăVl俾t]rgF!6/;\VennDiagram/tests/testthat/data/plotsOne.rda0000644000176200001440000000141714221171123020650 0ustar liggesusersVn0vlx*`W BBB4.pS75s({n+l؍ԉU0h>wo!u)vm@TC.ZDQ+au(u5zlD?Mkcv+qG{Z_:#7 x1,a` U4޸ 7$9OFR?վ=vaѓ4X8+ih:O-FP9*za!2} sml>7Uݞu=)FvS@+_7^{dF q_*-޹ [ CLj ,mBYh*O;q/VfqX|{@ntsw*cs`W0$cBЙmĈWvXZpg'vlt0m;v"#‹}rYO^:sb3e 9SBUW;u9JsP'+7[`17:?U@1shYd}Y #ȺUm[m?D3Adoh,%JIw1yٙLg|/:ĕ:E" KFTZvphs323|kψ`@=#1?=5u^gw\Wnk̼܌tѳy.xO $'^!E6=]5:mj4}VFo<ؼ9TOm_zO &va6Q+\9^/tH3ߵ(]LJ:씸WEi֎ a턁mf:U_H,DG6k#t 3A4g5h$t$}8jxNa9y׌o5<7u|{egCu3_ܫ Չ[xNNF\wfu& 4|f $~nqJ,6bKѶͧgV'dS%:1NTcK?hfuBL^WE%ЉtRmrݦA|DlD~DUPl?xWTEWsJ9%pKokiw+Ut0wP(/Ќ{^N+!-I/հ=Lcn]M%%!m\3aCV׳}0lKiz'ԐTgxRCF.D{F ƈ km%9קL;:rPuy@ktnBt CuXn-ud4 :!\qJ褼ϲNW'?&D6pG`V'ts$ )ltzwN F'kFW:A>tB8K W'%K?t|p@GHNE^U҅qW&.̤sAlg IxK -GŻa ޲Gx~aDN\ޣ x-[25 o*N6 թwY:0p^.#o&f?O3@ݭX t!3bLc$:V‡ÿ[tG]+!JTPip=>}C'gI):A>tB6K`WE%ЉtuB8K :W'u{WL:A>t“rD~RSPfujaD_iDk<N; uV'=J -{׸ڂ-zķw}|,i@`U`l;R~SX[QF^/lUBE虘ʭF5:/|_ ƈ u:1pׄ:iQs Űi%$`%01Tgݚn1RyΑfsbY6:i^S :A>tH %P:x,s[kj-=hqۭfon\}&5xQ}I·l߰rbp)6m71t/հ8!8TR8쌬+hIg ˪hxaChjaE2DX+t 3  3b6#j&ekh[ 0JkZ/w׉[xNXwF2#[ik?n'ȇN 1NT'D~2̐eCfхYfpni]׫߾mtgpE-n^>wRp/V{?g oXp R8x3GLpc~ Csi _OYqe|7^) s."/|wư^[k1=HۂCжZ/vMygX#hMZ ¡[Qiݕ'J :![p(Qګ:qwi!l.8ִ^t"?b5]:х~ Ak*4])i馗D@M%Uyw<i㭶)_lMB!y ִaMMbkX3?\unAt2YCRk}ୄ5]-5jt1D^RoF?mkBmMΩy2{qg|jsU+iJ0T7@'ȇNXnᢓ5g- :t2qJXӳ*1хᑨٷik%kv~ё6&*(kݙ?ޒ5][T]dza o ou75/fR f!imS%\<--Wwxi|7hψ=$pFa|PǗ:yjs]+̓Yn^`nQ:pd:kZ/:r=όIkJ~f-=hmYpXn,.Yn M#\hA\#O‚$r?ޒ 動B:T0bSx[1x+XnC.pG$fc.p43<^ЇC#3#a+)+3nPkzκF::`S'#9S}g> {[֌,-=h} xKD㪆ꥉtn9H0̷1IkӧټՆ2&8+k˭Rug (4j+]%+nEx0j+=$|,(|˶ Vbp2+aPB&Gb?"O +ڼR5w~W( FzgJ8QR8}wy #ϨPnsP}Bo4+: t!3顯+wXdyn>_=܄Z dV<::9*HZQ tbԏy x/|_ShΈ`FzH&) GO>R> ѵȬHPNSWN F'nm ^'8kI|@'ȇNx2H{UT@'3t:sdWE%Љ^rAޘu {,u-sAg \Ppųt۷pnj-zķ .6<>=t/[ěe  oTVvuáOx-hqe" y[ꅦԁxCƲ^_ОQ3.C8#1}MS8E$^+\ +VVbbz G sߵY.8ִquRQ C^@'z655c"]4_Y=)F6x6[6WeIMwK>hMAś7RnQPV>5pCۆJs<,݈<18rn^pagIBA$݀hK@w|MKx+yGwZtl*LP}"#A(ȗPx2HUT@(cG>ZGD(H(`SF(#_ox.VZ?Z{ܦLY \x?Kh9¤t)%(keY,?ߒM}3:MkbJ|ZWh!5f"q ck"ߍ'F>6u͑19B %~ HA nBmS]2!ܓtooṴ&DTr11b9U | MOȏX澽%)K{"o-E7+Λ%7.EvfA!\+wŠs'}?ߒϾ7npt8CV&rϪ%bā#Bp_7Ϭl80uYA =":[K>=bߓX$ ^D{Hl qtZo3;gBMw#vpD(XoܷpLMo#-gȝc it*L˒1,e&EMO|K&^k*JH7n! 0\3ĂʋvjPm=p65:_0}VennDiagram/tests/testthat/test-Two.R0000644000176200001440000000347014221171123017316 0ustar liggesusers#Testing using package testthat for detailed error messages library(testthat) #Get the testing function applied to compare the two venn diagram objects source('testFunction.R'); #load in the reference plot data load('data/plotsTwo.rda'); #Suppress plotting for sanity options(device=pdf(file = NULL)); #initialize the testing list of venn diagrams venn.test <- list(); #Scaled venn.test <- c(venn.test,list(draw.pairwise.venn(100, 70, 30, c('First', 'Second')))) #Not scaled venn.test <- c(venn.test,list(draw.pairwise.venn(100, 70, 30, c('First', 'Second'), scaled = FALSE))) #Area Labels venn.test <- c(venn.test,list(draw.pairwise.venn( #area1 = 90, area1 = 100, area2 = 70, cross.area = 68, category = c('First', 'Second'), #fill = c('green', 'red'), fill = c('blue', 'red'), lty = 'blank', cex = 2, cat.cex = 2, cat.pos = c(285, 105), cat.dist = 0.09, cat.just = list(c(-1, -1), c(1, 1)), ext.pos = 30, ext.dist = -0.05, ext.length = 0.85, ext.line.lwd = 2, ext.line.lty = 'dashed' ))) #No intersect venn.test <- c(venn.test,list(draw.pairwise.venn( area1 = 100, area2 = 70, cross.area = 0, category = c('First', 'Second'), cat.pos = c(0, 180), euler.d = TRUE, sep.dist = 0.03, rotation.degree = 45 ))) venn.test <- prepare.test.cases(venn.test); testNames <- c('scaled','not-scaled','area-labels','no-intersect'); #Loop over all of the test cases for(i in 1:length(venn.test)){ test_that( paste( 'Case', testNames[i], 'of two categories'), { for (j in 1:length(venn.test[[i]])) { expect_true( is_identical_without_name( venn.test[[i]][[j]], venn.plot[[i]][[j]], maxLength=3 ) ); } } ) } VennDiagram/tests/testthat/testFunction.R0000644000176200001440000000474214225106612020265 0ustar liggesuserslibrary(testthat); #Checks that the two objects in the plot are the same with the exception of the name #Reports the number of errors along with the types of the differing fields is_identical_without_name <- function(x, y,maxLength=5){ list.x <- unlist(x); list.y <- unlist(y); raw.x <- as.list(list.x[!names(list.x) %in% c('name')]); raw.y <- as.list(list.y[!names(list.y) %in% c('name')]); raw.x$'x' <- as.numeric(raw.x$'x'); raw.x$'y' <- as.numeric(raw.x$'y'); raw.y$'x' <- as.numeric(raw.y$'x'); raw.y$'y' <- as.numeric(raw.y$'y'); ret <- isTRUE(all.equal(raw.x,raw.y)); if(!ret)#If there are differences between them, then print them out { diffInd <- c( which(!(raw.x %in% raw.y)), if (length(raw.y) > length(raw.x)) (length(raw.x) + 1):length(raw.y) else c() ); diffNames <- names(raw.x)[diffInd];#Get the name of the differences diffValuesX <- raw.x[diffInd]; diffValuesY <- raw.y[diffInd]; totalDiff <- length(diffValuesY); numericDiff <- length(which(!is.na(as.numeric(diffValuesX)))); characterDiff <- length(which(is.na(as.numeric(diffValuesX)))); #If there are more than maxLength values to print, only print the first maxLength differences if (length(diffInd) > maxLength){ diffNameStr <- paste0(toString(diffNames[1:maxLength]),'...'); diffStrX <- paste0(toString(diffValuesX[1:maxLength]),'...'); diffStrY <- paste0(toString(diffValuesY[1:maxLength]),'...'); } else{ diffNameStr <- toString(diffNames); diffStrX <- toString(diffValuesX); diffStrY <- toString(diffValuesY); } print(paste('has different', paste0('(', diffNameStr, ')'), 'in', x)); print(paste('Total:', totalDiff, '| Numeric:', numericDiff, '| Character:', characterDiff)); print(paste('The values are', paste0('(', diffStrX, ')'), 'compared to', paste0('(', diffStrY, ')'))); } return(ret); } prepare.test.cases <- function(venn.test) { for (i in 1:length(venn.test)) { for (j in 1:length(venn.test[[i]])) { test.grob <- venn.test[[i]][[j]]; if (is(test.grob, 'polygon')) { # Strip polygons of their x and y values # This is also included in the params field venn.test[[i]][[j]]$x <- NULL; venn.test[[i]][[j]]$y <- NULL; } else if (is(test.grob, 'text')) { # Strip text of duplicate fontface value # for backwards compatbility venn.test[[i]][[j]]$gp$fontface <- NULL; } } } return (venn.test); }VennDiagram/tests/testthat/Rplots.pdf0000644000176200001440000000024314225106154017424 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20220411131540) /ModDate (D:20220411131540) /Title (R Graphics Output) /Producer (R 4.1.2) /Creator (R) >> endobj VennDiagram/tests/testthat/test-Three.R0000644000176200001440000002070514221171123017614 0ustar liggesusers#Testing using package testthat for detailed error messages library(testthat) #Get the testing function applied to compare the two venn diagram objects source('testFunction.R'); #load in the reference plot data load('data/plotsThree.rda'); #Suppress plotting for sanity options(device=pdf(file = NULL)); #initialize the testing list of venn diagrams venn.test <- list(); #Default venn.test <- c(venn.test,list(draw.triple.venn(65, 75, 85, 35, 15, 25, 5, c('First', 'Second', 'Third')))) #Default and Colour venn.test <- c(venn.test,list(draw.triple.venn( area1 = 65, area2 = 75, area3 = 85, n12 = 35, n23 = 15, n13 = 25, n123 = 5, category = c('First', 'Second', 'Third'), fill = c('blue', 'red', 'green'), lty = 'blank', cex = 2, cat.cex = 2, cat.col = c('blue', 'red', 'green') ))) #001 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 4, area2 = 3, area3 = 4, n12 = 2, n23 = 2, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), #category = c('C','B','A'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #010 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 3, area2 = 3, area3 = 4, n12 = 1, n23 = 2, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #011A venn.test <- c(venn.test,list(draw.triple.venn( area1 = 3, area2 = 2, area3 = 4, n12 = 1, n23 = 2, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #011O venn.test <- c(venn.test,list(draw.triple.venn( area1 = 3, area2 = 3, area3 = 3, n12 = 1, n23 = 2, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #012AA venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 2, area3 = 4, n12 = 1, n23 = 2, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #021AA venn.test <- c(venn.test,list(draw.triple.venn( area1 = 3, area2 = 1, area3 = 3, n12 = 1, n23 = 1, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #022AAAO venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 1, area3 = 3, n12 = 1, n23 = 1, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #022AAOO venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 2, area3 = 2, n12 = 1, n23 = 1, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #023 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 1, area3 = 2, n12 = 1, n23 = 1, n13 = 2, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #032 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 1, area3 = 1, n12 = 1, n23 = 1, n13 = 1, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #033 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 1, area2 = 1, area3 = 1, n12 = 1, n23 = 1, n13 = 1, n123 = 1, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #100 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 3, area2 = 3, area3 = 3, n12 = 1, n23 = 1, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #110 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 2, area3 = 3, n12 = 0, n23 = 1, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #111A venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 1, area3 = 3, n12 = 0, n23 = 1, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #112AA venn.test <- c(venn.test,list(draw.triple.venn( area1 = 1, area2 = 1, area3 = 3, n12 = 0, n23 = 1, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #120 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 2, area2 = 1, area3 = 2, n12 = 0, n23 = 0, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #121AO venn.test <- c(venn.test,list(draw.triple.venn( area1 = 1, area2 = 1, area3 = 2, n12 = 0, n23 = 0, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #122AAOO venn.test <- c(venn.test,list(draw.triple.venn( area1 = 1, area2 = 1, area3 = 1, n12 = 0, n23 = 0, n13 = 1, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) #130 venn.test <- c(venn.test,list(draw.triple.venn( area1 = 1, area2 = 1, area3 = 1, n12 = 0, n23 = 0, n13 = 0, n123 = 0, category = c('A', 'B', 'C'), fill = c('red', 'blue', 'green'), cat.col = c('red', 'blue', 'green'), cex = c(1/2,2/2,3/2,4/2,5/2,6/2,7/2), cat.cex = c(1,2,3), euler = TRUE, scaled = FALSE ))) venn.test <- prepare.test.cases(venn.test); testNames <- c('default','colour-default','001','010','011A','011O','012AA','021AA','022AAAO','022AAOO','023','032','033','100','110','111A','112AA','120','121AO','122AAOO','130'); #Loop over all of the test cases for (i in 1:length(venn.plot)) { test_that( paste('Case',testNames[i],'of three categories'), { for(j in 1:length(venn.plot[[i]])) { expect_true( is_identical_without_name( venn.test[[i]][[j]], venn.plot[[i]][[j]] ) ); } } ); } VennDiagram/NEWS0000755000176200001440000002777514225107103013164 0ustar liggesusersVennDiagram 1.7.3 2022-04-08 (Dan Knight) --------------------------------------------------------------------------------------------------- BUG * Improved type checking using more robust is functions instead of comparing the class name string VennDiagram 1.7.2 2022-03-31 (Dan Knight) --------------------------------------------------------------------------------------------------- BUG * Fixed bug in label positioning VennDiagram 1.7.1 2021-12-01 (Dan Knight) --------------------------------------------------------------------------------------------------- BUG * Modified test functions to be compatible with different versions of the R graphics engine VennDiagram 1.7.0 2021-10-18 (Dan Knight) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added option to disable .log file output and print to console instead * Updated coding style to current lab standards - Changed double quotes to single quotes BUG * Changed example output to avoid creating new image and log files in the package directory VennDiagram 1.6.22 2018-08-13 (Christopher Lalansingh) --------------------------------------------------------------------------------------------------- MINOR UPDATES * A table in the latex documentation was poorly formatted and extended beyond the width of the page, now resolved VennDiagram 1.6.21 2018-06-04 (Jeffrey Green) --------------------------------------------------------------------------------------------------- MINOR UPDATES * fixed bug with pairwise where inverted would mess up labels VennDiagram 1.6.20 2018-03-28 (Jeffrey Green) --------------------------------------------------------------------------------------------------- MINOR UPDATES * fixed bug with pairwise where cex was not being referenced properly when overlap could not fit label VennDiagram 1.6.19 2017-02-16 (Jeffrey Green) --------------------------------------------------------------------------------------------------- MINOR UPDATES * fixed bug with stop always executing when cex.prop is set VennDiagram 1.6.18 2017-11-20 (Jeffrey Green) --------------------------------------------------------------------------------------------------- MINOR UPDATES * fixed issues with calculate.overlap where doing -which with an empty charcter vector gave wrong results * fixed colour/border mismatch in quad venn VennDiagram 1.6.17 2016-04-16 (Christopher Lalansingh) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Updated tests for compatibility with testthat v1.0 * Exposed the lower.tail argument of the hypergeometric test in the venn.diagram function (still defaults to TRUE) VennDiagram 1.6.16 2015-09-09 (Christopher Lalansingh) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Changed the appended datetime string for log files to substitute spaces and colons correctly. VennDiagram 1.6.15 2015-08-25 (Christopher Lalansingh) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Changed import calls to fix undefined globals due to new CRAN policies. VennDiagram 1.6.14 2015-05-27 (David Wang) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added futile logger support. Currently outputs logs to console (using root logger). Replaced print()'s with flog.info and appended flog.error after the stop()'s. * By default outputs to file if you access it through the venn.diagram function * Also logs the arguments used in the venn.diagram call VennDiagram 1.6.13 2015-05-27 (David Wang) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Can print two fields for each bin. print.mode = c("raw","percent") prints the percent in brackets underneath the raw value. c("percent","raw") makes it print the raw number in brackets underneath the percent. * Can specify the number of significant digits in the percent by field sigdigs. Default is 3 * Can enter area fields directly for the three, four and five category venn diagrams. Need to know which areas correspond to what in order to use this. * Added Richard Cotton's code for creating in text a table of the partitions of the Venn Diagram. Useful for viewing and obtaining the area of each piece for evaluation before creating the Venn Diagram. Can be useful in its own right to get the area of each partition. VennDiagram 1.6.12 2015-05-22 (David Wang) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Refactored the 19 three categroy special case drawing functions into 2 functions (in two files) * Streamlined rotate.sp.R file. VennDiagram 1.6.11 2015-05-08 (David Wang) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Fixed bug with draw.121AO.R. Need to try both forward and reverse rotations. * Added optional parameter field "percents" which defaults to FALSE. Prints percent of total area with 4 significant digits VennDiagram 1.6.11 2015-01-02 (Warren W. Kretzschmar) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added cex.prop argument which can be a function or string used to scale the areas of the groups and labels in the diagram VennDiagram 1.6.10 2015-01-02 (vsabelnykova) --------------------------------------------------------------------------------------------------- MINOR UPDATES * If filename = FALSE, then returns a list called overlap, which contains the user provided elements but split by areas in Venn diagram and the gList (graphics list) which can then be plotted separately. VennDiagram 1.6.9 2014-09-24 (clalansingh) --------------------------------------------------------------------------------------------------- BUG FIXES * correctly handles a corner case of pairwise venn diagrams where only the values and labels are specified VennDiagram 1.6.8 2014-09-11 (clalansingh) --------------------------------------------------------------------------------------------------- BUG FIXES * correctly handle inversions of pairwise venn diagrams with correct labelling and positioning of ellipses VennDiagram 1.6.7 2014-06-25 (rsun) --------------------------------------------------------------------------------------------------- BUG FIXES * correctly handle NULLs passed to draw.pairwise.venn (either directly or through venn.diagram) VennDiagram 1.6.6 2013-09-05 (malbuquerque) --------------------------------------------------------------------------------------------------- MINOR UPDATES * new argument added, 'imagetype', which allows for the specification of the image format (tiff, png or svg) VennDiagram 1.6.5 2013-08-21 (pboutros) --------------------------------------------------------------------------------------------------- BUG FIXES * element a7 not updated after rotations in all special-case ternary drawing functions VennDiagram 1.6.4 2013-07-10 (pboutros) --------------------------------------------------------------------------------------------------- MINOR UPDATES * reduce line-widths of documentation to 90 characters to meet a new CRAN policy (NOT enforced in R v3.0.1, only in R-patched) * made even more examples \dontrun{} to accommodate CRAN requests VennDiagram 1.6.3 2013-07-05 (pboutros) --------------------------------------------------------------------------------------------------- MINOR UPDATES * bug-fix in draw.010 that was not updating empty overlap regions properly after rotation VennDiagram 1.6.1 2013-05-20 (jhawley) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Triple, Quadruple, and Quintuple plots now notify what areas are negative * bug-fix in draw.022AA00 that was preventing properly scaled diagrams VennDiagram 1.6.0 2013-04-12 (jhawley) --------------------------------------------------------------------------------------------------- MINOR UPDATES * Removed 'list.order' as an argument for draw.triple.venn and implicitly mapped ordering for triple and double plots * Argument ordering no longer matches by sample size, but by order of lists (i-th data elements match with i-th elements in other arguments) * Added NEWS file to detail updates and fixes * Changed 'force.unique' to default to TRUE * circle.R is deprecated because of redundancies (using ellipse.R instead) * Created and updated documentation for draw.* functions BUG FIXES * Fixed ordering and rotation of labels and colours in double and triple Euler plots * Fixed 'NaN error' within find.dist.R * Changed output of rotate.sp from a two-element list to a four-element list for easier access to rotated vectors * Updated documentation to clarify code VennDiagram 1.5.4 2013-02-14 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added OICR header notification to all R files * Looks for Darwin-based machines and uses bitmapType=quartz instead of the default cairo VennDiagram 1.5.3 2013-01-03 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added 'inverted' command line parameter and removed it from parameter list (passed as one of 'Details Arguments') * Removed references to obsolete variable sp.cases from examples (old code still works silently) VennDiagram 1.5.1 2012-09-02 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added 'force.unique' argument to venn.diagram to only look at unique elements in list elements (defaults to FALSE) * Added examples in \dontrun{} to accommodate CRAN request * Code clean-up for clarity, efficiency, and consistency VennDiagram 1.4.0 2012-08-08 --------------------------------------------------------------------------------------------------- MAJOR UPDATES * Able to create quintuple Venn diagrams (very similar to quadruple diagrams; accessible through venn.diagram and draw.quintuple.venn) MINOR UPDATES * 'ext.percent' in draw.pairwise.venn now allows for individual manipulation of proportions VennDiagram 1.3.0 2012-07-03 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added 'ext.percent' argument in draw.pairwise.venn to allow user-specified proportion under which to trigger external text drawing VennDiagram 1.2.2 2012-06-18 --------------------------------------------------------------------------------------------------- BUG FIXES * Fixed NA and error handling VennDiagram 1.2.0 2012-04-29 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Enabled draw.pairwise to work with expressions * Documented how to output to screen and updated additional documentation BUG FIXES * Fixed an antialiasing issue * Fixed some special case issues VennDiagram 1.1.0 2011-09-28 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Ability to have separate category names VennDiagram 1.0.2 2011-05-15 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Ability to use expression values in titles VennDiagram 1.0.1 2011-04-18 --------------------------------------------------------------------------------------------------- MINOR UPDATES * Added 'offset' argument to some three-set Euler diagrams * Enabled drawing of title and subtitles * Minor updates to draw.special.case functions * Minor changes to how 'cat.just' format is correctly determined * Added ovverrideTriple arguent for specific scaling in triple diagrams VennDiagram 1.0.0 2010-06-28 --------------------------------------------------------------------------------------------------- MAJOR UPDATES * Initial release of code, based off of lattice * Displays single, double, triple, and quadruple Venn and Euler diagrams * Flexibility of fonts, colours, spacing, and borders VennDiagram/R/0000755000176200001440000000000014224612673012655 5ustar liggesusersVennDiagram/R/draw.quintuple.venn.R0000644000176200001440000004015714225104025016722 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW VENN DIAGRAM WITH FIVE SETS ################################################# draw.quintuple.venn <- function( area1, area2, area3, area4, area5, n12, n13, n14, n15, n23, n24, n25, n34, n35, n45, n123, n124, n125, n134, n135, n145, n234, n235, n245, n345, n1234, n1235, n1245, n1345, n2345, n12345, category = rep('', 5), lwd = rep(2, 5), lty = rep('solid', 5), col = rep('black', 5), fill = NULL, alpha = rep(0.5, 5), label.col = rep('black', 31), cex = rep(1, 31), fontface = rep('plain', 31), fontfamily = rep('serif', 31), cat.pos = c(0, 287.5, 215, 145, 70), cat.dist = rep(0.2, 5), cat.col = rep('black', 5), cat.cex = rep(1, 5), cat.fontface = rep('plain', 5), cat.fontfamily = rep('serif', 5), cat.just = rep(list(c(0.5, 0.5)), 5), rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, cex.prop=NULL, print.mode = 'raw', sigdigs=3, direct.area=FALSE, area.vector=0, ... ) { #area1 > area2 > area3 > area4 > area5 # check parameter lengths if (length(category) == 1) { cat <- rep(category, 5); } else if (length(category) != 5) { flog.error('Unexpected parameter length for "category"",name="VennDiagramLogger') stop('Unexpected parameter length for "category"'); } if (length(lwd) == 1) { lwd <- rep(lwd, 5); } else if (length(lwd) != 5) { flog.error('Unexpected parameter length for "lwd"",name="VennDiagramLogger') stop('Unexpected parameter length for "lwd"'); } if (length(lty) == 1) { lty <- rep(lty, 5); } else if (length(lty) != 5) { flog.error('Unexpected parameter length for "lty"",name="VennDiagramLogger') stop('Unexpected parameter length for "lty"'); } if (length(col) == 1) { col <- rep(col, 5); } else if (length(col) != 5) { flog.error('Unexpected parameter length for "col"",name="VennDiagramLogger') stop('Unexpected parameter length for "col"'); } if (length(label.col) == 1) { label.col <- rep(label.col, 31); } else if (length(label.col) != 31) { flog.error('Unexpected parameter length for "label.col"",name="VennDiagramLogger') stop('Unexpected parameter length for "label.col"'); } if (length(cex) == 1) { cex <- rep(cex, 31); } else if (length(cex) != 31) { flog.error('Unexpected parameter length for "cex"",name="VennDiagramLogger') stop('Unexpected parameter length for "cex"'); } if (length(fontface) == 1) { fontface <- rep(fontface, 31); } else if (length(fontface) != 31) { flog.error('Unexpected parameter length for "fontface"",name="VennDiagramLogger') stop('Unexpected parameter length for "fontface"'); } if (length(fontfamily) == 1) { fontfamily <- rep(fontfamily, 31); } else if (length(fontfamily) != 31) { flog.error('Unexpected parameter length for "fontfamily"",name="VennDiagramLogger') stop('Unexpected parameter length for "fontfamily"'); } if (length(fill) == 1) { fill <- rep(fill, 5); } else if (length(fill) != 5 & length(fill) != 0) { flog.error('Unexpected parameter length for "fill"",name="VennDiagramLogger') stop('Unexpected parameter length for "fill"'); } if (length(alpha) == 1) { alpha <- rep(alpha, 5); } else if (length(alpha) != 5 & length(alpha) != 0) { flog.error('Unexpected parameter length for "alpha"",name="VennDiagramLogger') stop('Unexpected parameter length for "alpha"'); } if (length(cat.pos) == 1) { cat.pos <- rep(cat.pos, 5); } else if (length(cat.pos) != 5) { flog.error('Unexpected parameter length for "cat.pos"",name="VennDiagramLogger') stop('Unexpected parameter length for "cat.pos"'); } if (length(cat.dist) == 1) { cat.dist <- rep(cat.dist, 5); } else if (length(cat.dist) != 5) { flog.error('Unexpected parameter length for "cat.dist"",name="VennDiagramLogger') stop('Unexpected parameter length for "cat.dist"'); } if (length(cat.col) == 1) { cat.col <- rep(cat.col, 5); } else if (length(cat.col) != 5) { flog.error('Unexpected parameter length for "cat.col"",name="VennDiagramLogger') stop('Unexpected parameter length for "cat.col"'); } if (length(cat.cex) == 1) { cat.cex <- rep(cat.cex, 5); } else if (length(cat.cex) != 5) { flog.error('Unexpected parameter length for "cat.cex"",name="VennDiagramLogger') stop('Unexpected parameter length for "cat.cex"'); } if (length(cat.fontface) == 1) { cat.fontface <- rep(cat.fontface, 5); } else if (length(cat.fontface) != 5) { flog.error('Unexpected parameter length for "cat.fontface"",name="VennDiagramLogger') stop('Unexpected parameter length for "cat.fontface"'); } if (length(cat.fontfamily) == 1) { cat.fontfamily <- rep(cat.fontfamily, 5); } else if (length(cat.fontfamily) != 5) { flog.error('Unexpected parameter length for "cat.fontfamily"",name="VennDiagramLogger') stop('Unexpected parameter length for "cat.fontfamily"'); } if (!(is.list(cat.just) && length(cat.just) == 5 && length(cat.just[[1]]) == 2 && length(cat.just[[2]]) == 2 && length(cat.just[[3]]) == 2 && length(cat.just[[4]]) == 2 && length(cat.just[[5]]) == 2)) { flog.error('Unexpected parameter format for "cat.just"",name="VennDiagramLogger') stop('Unexpected parameter format for "cat.just"'); } cat.pos <- cat.pos + rotation.degree; if(direct.area){ areas <- area.vector; #create the variables and assign their values from the area vector for(i in 1:31) { assign(paste('a',i,sep=''),area.vector[i]); } } else{ # generate partial areas from given arguments a31 <- n12345; a30 <- n1234 - a31; a29 <- n1235 - a31; a28 <- n1245 - a31; a27 <- n1345 - a31; a26 <- n2345 - a31; a25 <- n245 - a26 - a28 - a31; a24 <- n234 - a26 - a30 - a31; a23 <- n134 - a27 - a30 - a31; a22 <- n123 - a29 - a30 - a31; a21 <- n235 - a26 - a29 - a31; a20 <- n125 - a28 - a29 - a31; a19 <- n124 - a28 - a30 - a31; a18 <- n145 - a27 - a28 - a31; a17 <- n135 - a27 - a29 - a31; a16 <- n345 - a26 - a27 - a31; a15 <- n45 - a18 - a25 - a16 - a28 - a27 - a26 - a31; a14 <- n24 - a19 - a24 - a25 - a30 - a28 - a26 - a31; a13 <- n34 - a16 - a23 - a24 - a26 - a27 - a30 - a31; a12 <- n13 - a17 - a22 - a23 - a27 - a29 - a30 - a31; a11 <- n23 - a21 - a22 - a24 - a26 - a29 - a30 - a31; a10 <- n25 - a20 - a21 - a25 - a26 - a28 - a29 - a31; a9 <- n12 - a19 - a20 - a22 - a28 - a29 - a30 - a31; a8 <- n14 - a18 - a19 - a23 - a27 - a28 - a30 - a31; a7 <- n15 - a17 - a18 - a20 - a27 - a28 - a29 - a31; a6 <- n35 - a16 - a17 - a21 - a26 - a27 - a29 - a31; a5 <- area5 - a6 - a7 - a15 - a16 - a17 - a18 - a25 - a26 - a27 - a28 - a31 - a20 - a29 - a21 - a10; a4 <- area4 - a13 - a14 - a15 - a16 - a23 - a24 - a25 - a26 - a27 - a28 - a31 - a18 - a19 - a8 - a30; a3 <- area3 - a21 - a11 - a12 - a13 - a29 - a22 - a23 - a24 - a30 - a31 - a26 - a27 - a16 - a6 - a17; a2 <- area2 - a9 - a10 - a19 - a20 - a21 - a11 - a28 - a29 - a31 - a22 - a30 - a26 - a25 - a24 - a14; a1 <- area1 - a7 - a8 - a18 - a17 - a19 - a9 - a27 - a28 - a31 - a20 - a30 - a29 - a22 - a23 - a12; # check plausibility and 0 partial areas areas <- c(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31); } areas.error <- c( 'a1 <- area1 - a7 - a8 - a18 - a17 - a19 - a9 - a27 - a28 - a31 - a20 - a30 - a29 - a22 - a23 - a12', 'a2 <- area2 - a9 - a10 - a19 - a20 - a21 - a11 - a28 - a29 - a31 - a22 - a30 - a26 - a25 - a24 - a14', 'a3 <- area3 - a21 - a11 - a12 - a13 - a29 - a22 - a23 - a24 - a30 - a31 - a26 - a27 - a16 - a6 - a17', 'a4 <- area4 - a13 - a14 - a15 - a16 - a23 - a24 - a25 - a26 - a27 - a28 - a31 - a18 - a19 - a8 - a30', 'a5 <- area5 - a6 - a7 - a15 - a16 - a17 - a18 - a25 - a26 - a27 - a28 - a31 - a20 - a29 - a21 - a10', 'a6 <- n35 - a16 - a17 - a21 - a26 - a27 - a29 - a31', 'a7 <- n15 - a17 - a18 - a20 - a27 - a28 - a29 - a31', 'a8 <- n14 - a18 - a19 - a23 - a27 - a28 - a30 - a31', 'a9 <- n12 - a19 - a20 - a22 - a28 - a29 - a30 - a31', 'a10 <- n25 - a20 - a21 - a25 - a26 - a28 - a29 - a31', 'a11 <- n23 - a21 - a22 - a24 - a26 - a29 - a30 - a31', 'a12 <- n13 - a17 - a22 - a23 - a27 - a29 - a30 - a31', 'a13 <- n34 - a16 - a23 - a24 - a26 - a27 - a30 - a31', 'a14 <- n24 - a19 - a24 - a25 - a30 - a28 - a26 - a31', 'a15 <- n45 - a18 - a25 - a16 - a28 - a27 - a26 - a31', 'a16 <- n345 - a26 - a27 - a31', 'a17 <- n135 - a27 - a29 - a31', 'a18 <- n145 - a27 - a28 - a31', 'a19 <- n124 - a28 - a30 - a31', 'a20 <- n125 - a28 - a29 - a31', 'a21 <- n235 - a26 - a29 - a31', 'a22 <- n123 - a29 - a30 - a31', 'a23 <- n134 - a27 - a30 - a31', 'a24 <- n234 - a26 - a30 - a31', 'a25 <- n245 - a26 - a28 - a31', 'a26 <- n2345 - a31', 'a27 <- n1345 - a31', 'a28 <- n1245 - a31', 'a29 <- n1235 - a31', 'a30 <- n1234 - a31', 'a31 <- n12345' ); for (i in 1:length(areas)) { if (areas[i] < 0) { flog.error(paste('Impossible:', areas.error[i], 'produces negative area'),name='VennDiagramLogger') stop(paste('Impossible:', areas.error[i], 'produces negative area')); } } ## rescaling area labels to be proportional to area if(length(cex.prop) > 0){ if(length(cex.prop) != 1) { flog.error('Value passed to cex.prop is not length 1',name='VennDiagramLogger') stop('Value passed to cex.prop is not length 1') } ## figure out what function to use func = cex.prop if (!is(cex.prop, 'function')) { if(cex.prop == 'lin'){ func = function(x) x } else if(cex.prop == 'log10'){ func = log10 } else flog.error(paste0('Unknown value passed to cex.prop: ', cex.prop),name='VennDiagramLogger') stop(paste0('Unknown value passed to cex.prop: ', cex.prop)) } ## rescale areas maxArea = max(areas) for(i in 1:length(areas)){ cex[i] = cex[i] * func(areas[i]) / func(maxArea) if(cex[i] <= 0) stop(paste0('Error in rescaling of area labels: the label of area ', i, ' is less than or equal to zero')) } } # initialize gList to hold all Grobs generated grob.list <- gList(); # plot the ellipses of the Venn diagram dist <- 0.13; a <- 0.24; b <- 0.46; init.angle <- -20; ellipse.positions <- matrix( nrow = 5, ncol = 3 ); colnames(ellipse.positions) <- c('x', 'y', 'rotation'); ellipse.positions[1,] <- c( 0.5 + dist * sin(init.angle * pi / 180), 0.5 + dist * cos(init.angle * pi / 180), 0 ); ellipse.positions[2,] <- c( 0.5 - dist * cos((288 + init.angle - 270) * pi / 180), 0.5 + dist * sin((288 + init.angle - 270) * pi / 180), -110 ); ellipse.positions[3,] <- c( 0.5 - dist * sin((216 + init.angle - 180) * pi / 180), 0.5 - dist * cos((216 + init.angle - 180) * pi / 180), 145 ); ellipse.positions[4,] <- c( 0.5 + dist * sin((180 - 144 - init.angle) * pi / 180), 0.5 - dist * cos((180 - 144 - init.angle) * pi / 180), 35 ); ellipse.positions[5,] <- c( 0.5 + dist * cos((init.angle + 72 - 90) * pi / 180), 0.5 - dist * sin((init.angle + 72 - 90) * pi / 180), -72.5 ); # create the ellipses for (i in 1:5) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = ellipse.positions[i,'x'], y = ellipse.positions[i,'y'], a = a, b = b, rotation = ellipse.positions[i,'rotation'], gp = gpar( lty = 0, fill = fill[i], alpha = alpha[i] ) ) ); } # create the ellipse borders for (i in 1:5) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = ellipse.positions[i,'x'], y = ellipse.positions[i,'y'], a = a, b = b, rotation = ellipse.positions[i,'rotation'], gp = gpar( lwd = lwd[i], lty = lty[i], col = col[i], fill = 'transparent' ) ) ); } # add area labels label.matrix <- matrix( nrow = 31, ncol = 3 ); colnames(label.matrix) <- c('label', 'x', 'y'); label.matrix[ 1,] <- c(a1, 0.4555, 0.9322); label.matrix[ 2,] <- c(a2, 0.0800, 0.6000); label.matrix[ 3,] <- c(a3, 0.3000, 0.1000); label.matrix[ 4,] <- c(a4, 0.7900, 0.1700); label.matrix[ 5,] <- c(a5, 0.9000, 0.6800); label.matrix[ 6,] <- c(a6, 0.7400, 0.6950); label.matrix[ 7,] <- c(a7, 0.6300, 0.8050); label.matrix[ 8,] <- c(a8, 0.4000, 0.7950); label.matrix[ 9,] <- c(a9, 0.2550, 0.7150); label.matrix[10,] <- c(a10, 0.1930, 0.4800); label.matrix[11,] <- c(a11, 0.2250, 0.3330); label.matrix[12,] <- c(a12, 0.4200, 0.2050); label.matrix[13,] <- c(a13, 0.5720, 0.1800); label.matrix[14,] <- c(a14, 0.7530, 0.3200); label.matrix[15,] <- c(a15, 0.8230, 0.4700); label.matrix[16,] <- c(a16, 0.7470, 0.5820); label.matrix[17,] <- c(a17, 0.6620, 0.7500); label.matrix[18,] <- c(a18, 0.4880, 0.7610); label.matrix[19,] <- c(a19, 0.3230, 0.7370); label.matrix[20,] <- c(a20, 0.2530, 0.5730); label.matrix[21,] <- c(a21, 0.2250, 0.3950); label.matrix[22,] <- c(a22, 0.3550, 0.2900); label.matrix[23,] <- c(a23, 0.5150, 0.2050); label.matrix[24,] <- c(a24, 0.6550, 0.2900); label.matrix[25,] <- c(a25, 0.7830, 0.4200); label.matrix[26,] <- c(a26, 0.7200, 0.4450); label.matrix[27,] <- c(a27, 0.6050, 0.7010); label.matrix[28,] <- c(a28, 0.3420, 0.6680); label.matrix[29,] <- c(a29, 0.2940, 0.4100); label.matrix[30,] <- c(a30, 0.5220, 0.2730); label.matrix[31,] <- c(a31, 0.5000, 0.5000); processedLabels <- rep('',length(label.matrix[,'label'])); if(print.mode[1] == 'percent'){ processedLabels <- paste(signif(label.matrix[,'label']/sum(label.matrix[,'label'])*100,digits=sigdigs),'%',sep=''); if(isTRUE(print.mode[2] == 'raw')) { processedLabels <- paste(processedLabels,'\n(',label.matrix[,'label'],')',sep=''); } } if(print.mode[1] == 'raw'){ processedLabels <- label.matrix[,'label']; if(isTRUE(print.mode[2] == 'percent')) { processedLabels <- paste(processedLabels,'\n(',paste(signif(label.matrix[,'label']/sum(label.matrix[,'label'])*100,digits=sigdigs),'%)',sep=''),sep=''); } } for (i in 1:nrow(label.matrix)) { tmp <- textGrob( label = processedLabels[i], x = label.matrix[i,'x'], y = label.matrix[i,'y'], gp = gpar( col = label.col[i], cex = cex[i], fontface = fontface[i], fontfamily = fontfamily[i] ) ); grob.list <- gList(grob.list, tmp); } # find the location and plot all the category names cat.pos.x <- c(0.4555, 0.08, 0.3, 0.79, 0.90); cat.pos.y <- c(0.9322, 0.60, 0.1, 0.17, 0.68); for (i in 1:5) { # find the label position this.cat.pos <- find.cat.pos( x = cat.pos.x[i], y = cat.pos.y[i], pos = cat.pos[i], dist = cat.dist[i] ); # and plot it grob.list <- gList( grob.list, textGrob( label = category[i], x = this.cat.pos$x, y = this.cat.pos$y, just = cat.just[[i]], gp = gpar( col = cat.col[i], cex = cat.cex[i], fontface = cat.fontface[i], fontfamily = cat.fontfamily[i] ) ) ); } #if (exists('margin')) {margin <- margin + 0.05} else {margin <- 0.05} # adjust grob.list to fit and return grob.list grob.list <- VennDiagram::adjust.venn(VennDiagram::rotate.venn.degrees(grob.list, rotation.degree, rotation.centre[1], rotation.centre[2]), ...); if (ind) { grid.draw(grob.list); } return(grob.list); } VennDiagram/R/hypergeometric.test.R0000755000176200001440000000447514112260207017005 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. #This function performs the hypergeometric test on the two categories. Taken from package BoutrosLab.statistics.general calculate.overlap.and.pvalue = function(list1, list2, total.size, lower.tail = TRUE, adjust = FALSE) { # calculate actual overlap actual.overlap <- length(intersect(list1, list2)); # calculate expected overlap # need to cast to avoid integer overflow when length(list1) * length(list2) is extremely large expected.overlap <- as.numeric(length(list1)) * length(list2) / total.size; adjust.value <- 0; # adjust actual.overlap to reflect P[X >= x] if (adjust & !lower.tail) { adjust.value <- 1; warning('Calculating P[X >= x]'); } # calculate significance of the overlap overlap.pvalue <- phyper( q = actual.overlap - adjust.value, m = length(list1), n = total.size - length(list1), k = length(list2), lower.tail = lower.tail ); # return values return( c(actual.overlap, expected.overlap, overlap.pvalue) ); } VennDiagram/R/get.venn.partitions.R0000644000176200001440000001433514221171123016710 0ustar liggesusersget.venn.partitions <- function(x, force.unique = TRUE, keep.elements = TRUE, hierarchical = FALSE) { #Check typing of arguments stopifnot(typeof(x)=='list'); stopifnot(typeof(force.unique)=='logical'); #Check for empty entries in the list emptyInds <- unlist(lapply(x,is.null)); if(any(emptyInds)){ warning('removing NULL elements in list.'); x <- x[!emptyInds]; } out <- make.truth.table(x) names(x) <- names(out);#The assignment of names to x doesn't carry over after the function call. Reassign it from the out dataframe # intersect and union will get unique values anyway, but there's no # point in the doing that many times. # Behaviour is equivalent to force.unique = TRUE in venn.diagram if(force.unique) { x <- lapply(x, unique) } else { x <- lapply(x, function(xRow){ ret <- data.frame(x=xRow) ret <- cbind(ret,1);#For aggregating into a count by summing colnames(ret) <- c('x','n'); ret <- aggregate(ret,by=list(ret$x),FUN=sum); ret$x <- ret$Group.1; ret$Group.1 <- NULL; return(ret); }); } # There are never any values outside all the sets, so don't bother with # case of FALSE in all columns. out <- out[apply(out, 1, any), ] #Compute the descriptive name of the set setNames <- apply( out, 1, function(categories) { include <- paste(names(x)[categories], collapse = '\u2229') # \u2229 = Unicode intersection if(all(categories)) { return(include) } include <- paste0('(',include,')'); exclude <- paste0('(',paste(names(x)[!categories], collapse = '\u222a'),')'); # \u222a = Unicode union paste(include, exclude, sep = '\u2216') # \u2216 = Unicode set difference } ); #Compute the values within the sets if(force.unique){ setValues <- apply( out, 1, function(categories) { include <- Reduce(intersect, x[categories]) exclude <- Reduce(union, x[!categories]) setdiff(include, exclude) } ); } else { if(hierarchical){ setValues <- apply( out, 1, function(categories) { #Assume that the number of a certain element is equal to the maximum number of that element in a category. #Take the one with the largest in the include group #And subtract from it the largest in the exclude group include <- Reduce(intersect, lapply(x[categories], function(z) z$x)) intData <- do.call(rbind,x[categories]); intSum <- aggregate(intData,by=list(intData$x),min); #Using the group names appended automatically by aggregate, reassign it to x intSum$x <- intSum$Group.1; intSum$Group.1 <- NULL; intInds <- intSum$x %in% include; intSum <- intSum[intInds,]; #If there is nothing to subtract out, then return the result if(all(categories)) { return(rep.int(intSum$x,intSum$n)); } #Find the categories to subtract out unionData <- do.call(rbind,x[!categories]); unionSum <- aggregate(unionData,by=list(unionData$x),max); #Using the group names appended automatically by aggregate, reassign it to x unionSum$x <- unionSum$Group.1; unionSum$Group.1 <- NULL; #Find the overlapping values overlapEle <- intersect(unionSum$x,intSum$x); #Index into the intersection set and the union set for subtraction intSum[match(overlapEle,intSum$x),2] <- pmax(intSum[match(overlapEle,intSum$x),2] - unionSum[match(overlapEle,unionSum$x),2],0); return(rep.int(intSum$x,intSum$n)); } ); }else{ setValues <- apply( out, 1, function(categories) { include <- Reduce(intersect, lapply(x[categories], function(z) z$x)) exclude <- Reduce(union, lapply(x[!categories], function(z) z$x)) #The unique names of the values to include y <- setdiff(include, exclude) totalData <- do.call(rbind,x[categories]); totalSum <- aggregate(totalData,by=list(totalData$x),sum); #Using the group names appended automatically by aggregate, reassign it to x totalSum$x <- totalSum$Group.1; totalSum$Group.1 <- NULL; #Find the x's that are in the actual set xInds <- totalSum$x %in% y; totalSum <- totalSum[xInds,]; return(rep.int(totalSum$x,totalSum$n)); } ); } } #Process the list of numbers into strings for easy cbinding setEle <- as.matrix(setValues); #Compute the total number of elements within each set setNum <- unlist(lapply(setValues,length)); #Bind all of the output together out <- cbind(out,setNames); out <- cbind(out,setEle); out <- cbind(out,setNum); colnames(out)[(ncol(out)-2):(ncol(out))] <- c('..set..','..values..','..count..'); #If the actual elements of the sets are not to be printed, remove them if(!keep.elements){ out <- out[,-(ncol(out)-1)]; } #Make the output of the set a character vector instead of a factor so you can encode the output out$..set.. <- as.character(out$..set..); Encoding(out$..set..) <- 'UTF-8' return(out) } VennDiagram/R/find.dist.R0000644000176200001440000000371614112260207014655 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO FIND DISTANCE BETWEEN CIRCLES ##################################################### find.dist <- function(area1, area2, cross.area, inverted = FALSE) { if (inverted) { r2 <- sqrt(area1 / pi); r1 <- sqrt(area2 / pi); } else { r1 <- sqrt(area1 / pi); r2 <- sqrt(area2 / pi); } # set up a sequence of distances corresponding to full intersection to 0 intersection with set resolution (step) d <- r1 + r2; resolution <- 0.001; d.list <- seq(r1 - r2 + resolution, d, resolution); int.list <- sapply(d.list, find.intersect, r1, r2); match.list <- (int.list >= cross.area); index.true <- length(match.list[match.list]); index.false <- index.true + 1; if (0 == index.true) { return(d.list[index.false]); } else { return(mean(d.list[index.true], d.list[index.false])); } } VennDiagram/R/ellipse.R0000644000176200001440000000302014112260207014414 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW ELLIPSE (IN FACT A POLYGON) ################################################### ellipse <- function(x, y, a, b, rotation = 0, gp = NULL) { poly <- VennDiagram::ell2poly(x, y, a, b, rotation, 3000); ret <- polygonGrob( x = poly$x, y = poly$y, gp = gp ) ret$params <- list(x=x, y=y, a=a, b=b, rotation=rotation); return(ret); } VennDiagram/R/draw.sp.case.preprocess.R0000644000176200001440000001705314221171123017445 0ustar liggesusers#Called if the sp.case.name is not one of these: 022AAAO, 022AAOO, 023, 032, 120, 121AO, 122AAOO, 130 #if(!sp.case.name %in% c('022AAAO', '022AAOO', '023', '032', '120', '121AO', '122AAOO', '130')) draw.sp.case.preprocess <- function( sp.case.name, a1, a2, a3, a4, a5, a6, a7, category = rep('', 3), reverse = FALSE, cat.default.pos = 'outer', lwd = rep(2, 3), lty = rep('solid', 3), col = rep('black', 3), label.col = rep('black', 7), cex = rep(1, 7), fontface = rep('plain', 7), fontfamily = rep('serif', 7), cat.pos = c(-40, 40, 180), cat.dist = c(0.05, 0.05, 0.025), cat.col = rep('black', 3), cat.cex = rep(1, 3), cat.fontface = rep('plain', 3), cat.fontfamily = rep('serif', 3), cat.just = list(c(0.5, 1), c(0.5, 1), c(0.5, 0)), cat.prompts = FALSE, fill = NULL, alpha = rep(0.5, 3), scaled = TRUE, offset = 0, sep.dist = rep(0.05, 3), print.mode='raw', sigdigs=3, ... ) { if(sp.case.name == '130') { sep.dist = rep(0.05,3); } area.zeroes <- list('023' = c(1,3,4,6,7), '022AAOO' = c(1,3,4,6), '001' = c(7), '010' = c(2), '011O' = c(2,7), '100' = c(5), '112AA' = c(1,4,5,7), '021AA' = c(4,6,7), '012AA' = c(1,4,7), '122AAOO' = c(1,3,4,5,6), '033' = c(1,2,3,4,6,7), '120' = c(4,5,6), '022AAAO' = c(3,4,6,7), '111A' = c(4,5,7), '011A' = c(4,7), '130' = c(2,4,5,6), '032' = c(2,3,4,6,7), '121AO' = c(3,4,5,6), '110' = c(4,5)); area.labels <- list('012AA' = c(2,3,6), '122AAOO' = c(2,2,7), '033' = c(5,5,5), '120' = c(1,3,7), '022AAAO' = c(1,2,5), '111A' = c(1,3,6), '011A' = c(1,3,6), '130' = c(1,3,7), '032' = c(1,5,5), '121AO' = c(1,2,7), '110' = c(1,3,7), '023' = c(2,2,5), '022AAOO' = c(2,2,7), '001' = c(1,3,5), '010' = c(1,3,5), '011O' = c(1,3,5), '100' = c(1,3,7), '112AA' = c(2,3,6), '021AA' = c(1,3,5)); a.x <- list('012AA' = c(0,0.3,0.5,0,0.5,0.7,0), '111A' = c(0.27,0.5,0.68,0,0,0.76,0), '011O' = c(0.175,0,0.825,0.325,0.5,0.675,0), '021AA' = c(0.2,0.5,0.8,0,0.5,0,0), '033' = c(0,0,0,0,0.5,0,0), '010' = c(0.18,0,0.82,0.32,0.5,0.68,0.5), '110' = c(0.175,0.375,0.5,0,0,0.625,0.825), '112AA' = c(0,0.34,0.5,0,0,0.66,0), '011A' = c(0.2,0.425,0.875,0,0.575,0.725,0), '100' = c(0.31,0.495,0.68,0.41,0,0.59,0.5), '001' = c(0.3,0.5,0.7,0.32,0.5,0.68,0)); a.y <- list('012AA' = c(0,0.5,0.775,0,0.5,0.5,0), '111A' = c(0.5,0.5,0.705,0,0,0.5,0), '011O' = c(0.5,0,0.5,0.5,0.5,0.5,0), '021AA' = c(0.5,0.675,0.5,0,0.5,0,0), '033' = c(0,0,0,0,0.5,0,0), '010' = c(0.5,0,0.5,0.54,0.51,0.54,0.75), '110' = c(0.5,0.5,0.5,0,0,0.5,0.5), '112AA' = c(0,0.5,0.725,0,0,0.5,0), '011A' = c(0.5,0.5,0.5,0,0.5,0.5,0), '100' = c(0.66,0.66,0.66,0.5,0,0.5,0.335), '001' = c(0.35,0.33,0.35,0.58,0.55,0.58,0)); centre.x <- list('012AA' = c(0.4,0.5,0.6), '111A' = c(0.32,0.68,0.76), '011O' = c(0.35,0.65,0.5), '021AA' = c(0.35,0.65,0.5), '033' = c(0.5,0.5,0.5), '010' = c(0.35,0.65,0.5), '110' = c(0.25,0.5,0.75), '112AA' = c(0.34,0.5,0.66), '011A' = c(0.35,0.65,0.65), '100' = c(0.31,0.68,0.5), '001' = c(0.4,0.6,0.5)); centre.y <- list('012AA' = c(0.5,0.5,0.5), '111A' = c(0.5,0.5,0.5), '011O' = c(0.5,0.5,0.5), '021AA' = c(0.5,0.5,0.5), '033' = c(0.5,0.5,0.5), '010' = c(0.5,0.5,0.55), '110' = c(0.5,0.5,0.5), '112AA' = c(0.5,0.5,0.5), '011A' = c(0.5,0.5,0.5), '100' = c(0.66,0.66,0.333), '001' = c(0.5,0.5,0.55)); radii <- list('012AA' = c(0.2,0.35,0.2), '111A' = c(0.27,0.27,0.14), '011O' = c(0.25,0.25,0), '021AA' = c(0.3,0.3,0.12), '033' = c(0.4,0.4,0.4), '010' = c(0.25,0.25,0.25), '110' = c(0.2,0.2,0.2), '112AA' = c(0.15,0.35,0.15), '011A' = c(0.3,0.3,0.15), '100' = c(0.216,0.216,0.216), '001' = c(0.25,0.25,0)); ######################Rotations #Need to check certain special rotations if(sp.case.name == '111A' || sp.case.name == '011A'){ for(i in 1:3){ tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), i, reverse); if (tmp$areas[7] == 0 & tmp$areas[4] == 0) { break; } if (tmp$areas[7] == 0 & tmp$areas[6] == 0) { tmp <- VennDiagram::rotate.sp(tmp$areas, 1, reverse = TRUE,additional.rot = TRUE,additional.o7=tmp$o7,additional.o3=tmp$o3); break; } } } else if(sp.case.name == '121AO'){ #Need to check all possible rotations for (i in 1:6) { tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), (i-1) %% 3 + 1, reverse = (i>3)); if (0 == tmp$areas[3] & 0 == tmp$areas[4] & 0 == tmp$areas[5] & 0 == tmp$areas[6]) { break; } } } else if(sp.case.name == '022AAAO'){#Need to make sure reverse = FALSE for (i in 1:3) { tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), i, reverse = FALSE); if (0 == tmp$areas[3] & 0 == tmp$areas[4] & 0 == tmp$areas[6] & 0 == tmp$areas[7]) { break; } } } else {#Normal rotations break.ind <- c(2,4,5,6);#Break if these tmp$areas are equal to zero #Get the break.ind by indexing a list by the sp.case.name break.ind <- area.zeroes[[sp.case.name]]; for (i in 1:3) { tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), i, reverse); if (all(tmp$areas[break.ind]==0)) { break; } } } a1 <- tmp$areas[1]; a2 <- tmp$areas[2]; a3 <- tmp$areas[3]; a4 <- tmp$areas[4]; a5 <- tmp$areas[5]; a6 <- tmp$areas[6]; a7 <- tmp$areas[7]; # 3-vector rotations fill <- fill[tmp$o3]; cat.col <- cat.col[tmp$o3]; category <- category[tmp$o3]; lwd <- lwd[tmp$o3]; lty <- lty[tmp$o3]; col <- col[tmp$o3]; alpha <- alpha[tmp$o3]; cat.dist <- cat.dist[tmp$o3]; cat.cex <- cat.cex[tmp$o3]; cat.fontface <- cat.fontface[tmp$o3]; cat.fontfamily <- cat.fontfamily[tmp$o3]; cat.just <- cat.just[tmp$o3]; # 7-vector rotations label.col <- label.col[tmp$o7]; cex <- cex[tmp$o7]; fontface <- fontface[tmp$o7]; fontfamily <- fontfamily[tmp$o7]; a1.x.pos <- 0; a1.y.pos <- 0; a2.x.pos <- 0; a2.y.pos <- 0; a3.x.pos <- 0; a3.y.pos <- 0; a4.x.pos <- 0; a4.y.pos <- 0; a5.x.pos <- 0; a5.y.pos <- 0; a6.x.pos <- 0; a6.y.pos <- 0; a7.x.pos <- 0; a7.y.pos <- 0; ###########Calculations of [xy].centre[1-3] and a[1-7].[xy].pos ########### Get the areas and positions by indexing into a vector using the sp.case.name. Don't have to do other caculations because these aren't the scaled cases. This is done directly in the return function call r1 <- radii[[sp.case.name]][1]; r2 <- radii[[sp.case.name]][2]; r3 <- radii[[sp.case.name]][3]; a.list = c(r1, r2, r3); b.list = c(r1, r2, r3); if(sp.case.name == '001' || sp.case.name == '011O') { a.list = c(r1,r2,0.25); if(sp.case.name == '001') { b.list = c(r1,r2,0.18); } else {#sp.case.name == '011O' b.list = c(r1,r2,0.2); } } if(!sp.case.name %in% c('011A','022AAAO','023','032','033','111A','121AO')) { reverse = FALSE; } straight.reverse = FALSE; if(!sp.case.name %in% c('011A','022AAAO','022AAOO','111A','120','121AO','122AAOO')) { straight.reverse = TRUE; } return( VennDiagram::draw.sp.case( area.list = c(a1, a2, a3, a4, a5, a6, a7), enabled.areas = setdiff(1:7,unlist(area.zeroes[sp.case.name])),#The enabled areas are those with non-zero areas area.x = a.x[[sp.case.name]], area.y = a.y[[sp.case.name]], attach.label.to = area.labels[[sp.case.name]], x.centres = centre.x[[sp.case.name]], y.centres = centre.y[[sp.case.name]], a.list = a.list, b.list = b.list, straight.reverse = straight.reverse, reverse = reverse, category = category, cat.default.pos = cat.default.pos, lwd = lwd, lty = lty, col = col, label.col = label.col, cex = cex, fontface = fontface, fontfamily = fontfamily, cat.pos = cat.pos, cat.dist = cat.dist, cat.col = cat.col, cat.cex = cat.cex, cat.fontface = cat.fontface, cat.fontfamily = cat.fontfamily, cat.just = cat.just, fill = fill, alpha = alpha, print.mode=print.mode, sigdigs=sigdigs, ... ) ); } VennDiagram/R/draw.quad.venn.R0000644000176200001440000003153214225104053015624 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW VENN DIAGRAM WITH FOUR SETS ################################################# draw.quad.venn <- function( area1, area2, area3, area4, n12, n13, n14, n23, n24, n34, n123, n124, n134, n234, n1234, category = rep('', 4), lwd = rep(2, 4), lty = rep('solid', 4), col = rep('black', 4), fill = NULL, alpha = rep(0.5, 4), label.col = rep('black', 15), cex = rep(1, 15), fontface = rep('plain', 15), fontfamily = rep('serif', 15), cat.pos = c(-15, 15, 0, 0), cat.dist = c(0.22, 0.22, 0.11, 0.11), cat.col = rep('black', 4), cat.cex = rep(1, 4), cat.fontface = rep('plain', 4), cat.fontfamily = rep('serif', 4), cat.just = rep(list(c(0.5, 0.5)), 4), rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, cex.prop=NULL, print.mode = 'raw', sigdigs=3, direct.area = FALSE, area.vector = 0, ... ) { #area1 > area2 > area3 > area4 # check parameter lengths if (length(category) == 1) { cat <- rep(category, 4); } else if (length(category) != 4) { flog.error('Unexpected parameter length for "category"',name='VennDiagramLogger') stop('Unexpected parameter length for "category"'); } if (length(lwd) == 1) { lwd <- rep(lwd, 4); } else if (length(lwd) != 4) { flog.error('Unexpected parameter length for "lwd"',name='VennDiagramLogger') stop('Unexpected parameter length for "lwd"'); } if (length(lty) == 1) { lty <- rep(lty, 4); } else if (length(lty) != 4) { flog.error('Unexpected parameter length for "lty"',name='VennDiagramLogger') stop('Unexpected parameter length for "lty"'); } if (length(col) == 1) { col <- rep(col, 4); } else if (length(col) != 4) { flog.error('Unexpected parameter length for "col"',name='VennDiagramLogger') stop('Unexpected parameter length for "col"'); } if (length(label.col) == 1) { label.col <- rep(label.col, 15); } else if (length(label.col) != 15) { flog.error('Unexpected parameter length for "label.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "label.col"'); } if (length(cex) == 1) { cex <- rep(cex, 15); } else if (length(cex) != 15) { flog.error('Unexpected parameter length for "cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cex"'); } if (length(fontface) == 1) { fontface <- rep(fontface, 15); } else if (length(fontface) != 15) { flog.error('Unexpected parameter length for "fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontface"'); } if (length(fontfamily) == 1) { fontfamily <- rep(fontfamily, 15); } else if (length(fontfamily) != 15) { flog.error('Unexpected parameter length for "fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontfamily"'); } if (length(fill) == 1) { fill <- rep(fill, 4); } else if (length(fill) != 4 & length(fill) != 0) { flog.error('Unexpected parameter length for "fill"',name='VennDiagramLogger') stop('Unexpected parameter length for "fill"'); } if (length(alpha) == 1) { alpha <- rep(alpha, 4); } else if (length(alpha) != 4 & length(alpha) != 0) { flog.error('Unexpected parameter length for "alpha"',name='VennDiagramLogger') stop('Unexpected parameter length for "alpha"'); } if (length(cat.pos) == 1) { cat.pos <- rep(cat.pos, 4); } else if (length(cat.pos) != 4) { flog.error('Unexpected parameter length for "cat.pos"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.pos"'); } if (length(cat.dist) == 1) { cat.dist <- rep(cat.dist, 4); } else if (length(cat.dist) != 4) { flog.error('Unexpected parameter length for "cat.dist"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.dist"'); } if (length(cat.col) == 1) { cat.col <- rep(cat.col, 4); } else if (length(cat.col) != 4) { flog.error('Unexpected parameter length for "cat.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.col"'); } if (length(cat.cex) == 1) { cat.cex <- rep(cat.cex, 4); } else if (length(cat.cex) != 4) { flog.error('Unexpected parameter length for "cat.cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.cex"'); } if (length(cat.fontface) == 1) { cat.fontface <- rep(cat.fontface, 4); } else if (length(cat.fontface) != 4) { flog.error('Unexpected parameter length for "cat.fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontface"'); } if (length(cat.fontfamily) == 1) { cat.fontfamily <- rep(cat.fontfamily, 4); } else if (length(cat.fontfamily) != 4) { flog.error('Unexpected parameter length for "cat.fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontfamily"'); } if (!(is.list(cat.just) && length(cat.just) == 4 && length(cat.just[[1]]) == 2 && length(cat.just[[2]]) == 2 && length(cat.just[[3]]) == 2 && length(cat.just[[4]]) == 2)) { flog.error('Unexpected parameter format for "cat.just"',name='VennDiagramLogger') stop('Unexpected parameter format for "cat.just"'); } cat.pos <- cat.pos + rotation.degree; if(direct.area){ areas <- area.vector; #create the variables and assign their values from the area vector for(i in 1:15) { assign(paste('a',i,sep=''),area.vector[i]); } } else { # generate partial areas from given arguments a6 <- n1234; a12 <- n123 - a6; a11 <- n124 - a6; a5 <- n134 - a6; a7 <- n234 - a6; a15 <- n12 - a6 - a11 - a12; a4 <- n13 - a6 - a5 - a12; a10 <- n14 - a6 - a5 - a11; a13 <- n23 - a6 - a7 - a12; a8 <- n24 - a6 - a7 - a11; a2 <- n34 - a6 - a5 - a7; a9 <- area1 - a4 - a5 - a6 - a10 - a11 - a12 - a15; a14 <- area2 - a6 - a7 - a8 - a11 - a12 - a13 - a15; a1 <- area3 - a2 - a4 - a5 - a6 - a7 - a12 - a13; a3 <- area4 - a2 - a5 - a6 - a7 - a8 - a10 - a11; # check plausibility and 0 partial areas areas <- c(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15); } areas.error <- c( 'a1 <- area3 - a2 - a4 - a5 - a6 - a7 - a12 - a13', 'a2 <- n34 - a6 - a5 - a7', 'a3 <- area4 - a2 - a5 - a6 - a7 - a8 - a10 - a11', 'a4 <- n13 - a6 - a5 - a12', 'a5 <- n134 - a6', 'a6 <- n1234', 'a7 <- n234 - a6', 'a8 <- n24 - a6 - a7 - a11', 'a9 <- area1 - a4 - a5 - a6 - a10 - a11 - a12 - a15', 'a10 <- n14 - a6 - a5 - a11', 'a11 <- n124 - a6', 'a12 <- n123 - a6', 'a15 <- n12 - a6 - a11 - a12', 'a13 <- n23 - a6 - a7 - a12', 'a14 <- area2 - a6 - a7 - a8 - a11 - a12 - a13 - a15' ); for (i in 1:length(areas)) { if (areas[i] < 0) { flog.error(paste('Impossible:', areas.error[i], 'produces negative area'),name='VennDiagramLogger') stop(paste('Impossible:', areas.error[i], 'produces negative area')); } } ## rescaling area labels to be proportional to area if(length(cex.prop) > 0){ if(length(cex.prop) != 1) { flog.error('Value passed to cex.prop is not length 1',name='VennDiagramLogger') stop('Value passed to cex.prop is not length 1') } ## figure out what function to use func = cex.prop if (!is(cex.prop, 'function')) { if(cex.prop == 'lin'){ func = function(x) x } else if(cex.prop == 'log10'){ func = log10 } else flog.error(paste0('Unknown value passed to cex.prop: ', cex.prop),name='VennDiagramLogger') stop(paste0('Unknown value passed to cex.prop: ', cex.prop)) } ## rescale areas maxArea = max(areas) for(i in 1:length(areas)){ cex[i] = cex[i] * func(areas[i]) / func(maxArea) if(cex[i] <= 0) stop(paste0('Error in rescaling of area labels: the label of area ', i, ' is less than or equal to zero')) } } # initialize gList to hold all Grobs generated grob.list <- gList(); # plot the ellipses of the Venn diagram ellipse.positions <- matrix( nrow = 4, ncol = 7 ); colnames(ellipse.positions) <- c('x', 'y', 'a', 'b', 'rotation', 'fill.mapping', 'line.mapping'); ellipse.positions[1,] <- c(0.65, 0.47, 0.35, 0.20, 45, 2, 2); ellipse.positions[2,] <- c(0.35, 0.47, 0.35, 0.20, 135, 1, 1); ellipse.positions[3,] <- c(0.50, 0.57, 0.33, 0.15, 45, 4, 4); ellipse.positions[4,] <- c(0.50, 0.57, 0.35, 0.15, 135, 3, 3); # draw the ellipses themselves for (i in 1:4) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = ellipse.positions[i,'x'], y = ellipse.positions[i,'y'], a = ellipse.positions[i,'a'], b = ellipse.positions[i,'b'], rotation = ellipse.positions[i, 'rotation'], gp = gpar( lty = 0, fill = fill[ellipse.positions[i,'fill.mapping']], alpha = alpha[ellipse.positions[i,'fill.mapping']] ) ) ); } # draw the ellipse borders for (i in 1:4) { grob.list <- gList( grob.list, ellipse( x = ellipse.positions[i,'x'], y = ellipse.positions[i,'y'], a = ellipse.positions[i,'a'], b = ellipse.positions[i,'b'], rotation = ellipse.positions[i, 'rotation'], gp = gpar( lwd = lwd[ellipse.positions[i,'line.mapping']], lty = lty[ellipse.positions[i,'line.mapping']], col = col[ellipse.positions[i,'line.mapping']], fill = 'transparent' ) ) ); } # create the labels label.matrix <- matrix( nrow = 15, ncol = 3 ); colnames(label.matrix) <- c('label', 'x', 'y'); label.matrix[ 1,] <- c(a1, 0.350, 0.77); label.matrix[ 2,] <- c(a2, 0.500, 0.69); label.matrix[ 3,] <- c(a3, 0.650, 0.77); label.matrix[ 4,] <- c(a4, 0.310, 0.67); label.matrix[ 5,] <- c(a5, 0.400, 0.58); label.matrix[ 6,] <- c(a6, 0.500, 0.47); label.matrix[ 7,] <- c(a7, 0.600, 0.58); label.matrix[ 8,] <- c(a8, 0.690, 0.67); label.matrix[ 9,] <- c(a9, 0.180, 0.58); label.matrix[10,] <- c(a10, 0.320, 0.42); label.matrix[11,] <- c(a11, 0.425, 0.38); label.matrix[12,] <- c(a12, 0.575, 0.38); label.matrix[13,] <- c(a13, 0.680, 0.42); label.matrix[14,] <- c(a14, 0.820, 0.58); label.matrix[15,] <- c(a15, 0.500, 0.28); processedLabels <- rep('',length(label.matrix[,'label'])); if(print.mode[1] == 'percent'){ processedLabels <- paste(signif(label.matrix[,'label']/sum(label.matrix[,'label'])*100,digits=sigdigs),'%',sep=''); if(isTRUE(print.mode[2] == 'raw')) { processedLabels <- paste(processedLabels,'\n(',label.matrix[,'label'],')',sep=''); } } if(print.mode[1] == 'raw'){ processedLabels <- label.matrix[,'label']; if(isTRUE(print.mode[2] == 'percent')) { processedLabels <- paste(processedLabels,'\n(',paste(signif(label.matrix[,'label']/sum(label.matrix[,'label'])*100,digits=sigdigs),'%)',sep=''),sep=''); } } for (i in 1:nrow(label.matrix)) { grob.list <- gList( grob.list, textGrob( label = processedLabels[i], x = label.matrix[i,'x'], y = label.matrix[i,'y'], gp = gpar( col = label.col[i], cex = cex[i], fontface = fontface[i], fontfamily = fontfamily[i] ) ) ); } # find the location and plot all the category names cat.pos.x <- c(0.18, 0.82, 0.35, 0.65); cat.pos.y <- c(0.58, 0.58, 0.77, 0.77); for (i in 1:4) { # work out location of the category label this.cat.pos <- find.cat.pos( x = cat.pos.x[i], y = cat.pos.y[i], pos = cat.pos[i], dist = cat.dist[i] ); # then print it grob.list <- gList( grob.list, textGrob( label = category[i], x = this.cat.pos$x, y = this.cat.pos$y, just = cat.just[[i]], gp = gpar( col = cat.col[i], cex = cat.cex[i], fontface = cat.fontface[i], fontfamily = cat.fontfamily[i] ) ) ); } # adjust grob.list to fit and return grob.list grob.list <- VennDiagram::adjust.venn(VennDiagram::rotate.venn.degrees(grob.list, rotation.degree, rotation.centre[1], rotation.centre[2]), ...); # draw diagram before returning gList is specified by user if (ind) { grid.draw(grob.list); } return(grob.list); } VennDiagram/R/rotate.venn.degrees.R0000644000176200001440000000434614112260207016653 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO ROTATE DIAGRAM BY DEGREES ######################################################### rotate.venn.degrees <- function(gList1, angle = 90, x.centre = 0.5, y.centre = 0.5) { x.vect <- vector(); y.vect <- vector(); x.list <- list(); y.list <- list(); x2.list <- list(); y2.list <- list(); for (i in 1:length(gList1)) { x.vect <- c(x.vect, as.vector(gList1[i][[1]]$x, mode = 'numeric')); x.list[[i]] <- as.vector(gList1[i][[1]]$x, mode = 'numeric'); } for (i in 1:length(gList1)) { y.vect <- c(y.vect, as.vector(gList1[i][[1]]$y, mode = 'numeric')); y.list[[i]] <- as.vector(gList1[i][[1]]$y, mode = 'numeric'); } for (i in 1:length(x.list)) { x2.list[[i]] <- (x.list[[i]] - x.centre) * cos(angle * pi / 180) - (y.list[[i]] - y.centre) * sin(angle * pi / 180) + x.centre; y2.list[[i]] <- (x.list[[i]] - x.centre) * sin(angle * pi / 180) + (y.list[[i]] - y.centre) * cos(angle * pi / 180) + y.centre; } for (i in 1:length(gList1)) { gList1[i][[1]]$y <- unit(y2.list[[i]], 'npc'); gList1[i][[1]]$x <- unit(x2.list[[i]], 'npc'); } return(gList1); } VennDiagram/R/flip.venn.R0000644000176200001440000000415514221171123014667 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. # flip a Venn diagram flip.venn <- function(gList1, axis = 'v') { x.vect <- vector(); y.vect <- vector(); x.list <- list(); y.list <- list(); if ('v' == axis) { for (i in 1:length(gList1)) { x.vect <- c(x.vect, as.vector(gList1[i][[1]]$x, mode = 'numeric')); x.list[[i]] <- as.vector(gList1[i][[1]]$x, mode = 'numeric'); } for (i in 1:length(x.list)) { x.list[[i]] <- unit(1 - x.list[[i]], 'npc') } for (i in 1:length(gList1)) { gList1[i][[1]]$x <- x.list[[i]] } return(gList1); } else if ('h' == axis) { for (i in 1:length(gList1)) { y.vect <- c(y.vect, as.vector(gList1[i][[1]]$y, mode = 'numeric')); y.list[[i]] <- as.vector(gList1[i][[1]]$y, mode = 'numeric'); } for (i in 1:length(y.list)) { y.list[[i]] <- unit(1 - y.list[[i]], 'npc') } for (i in 1:length(gList1)) { gList1[i][[1]]$y <- y.list[[i]] } return(gList1); } else { flog.error('Unknown axis type',name='VennDiagramLogger') stop('Unknown axis type'); } } VennDiagram/R/draw.triple.venn.R0000644000176200001440000005177714225104112016202 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW VENN DIAGRAM WITH THREE SETS ################################################# draw.triple.venn <- function( area1, area2, area3, n12, n23, n13, n123, category = rep('', 3), rotation = 1, reverse = FALSE, euler.d = TRUE, scaled = TRUE, lwd = rep(2, 3), lty = rep('solid', 3), col = rep('black', 3), fill = NULL, alpha = rep(0.5, 3), label.col = rep('black', 7), cex = rep(1, 7), fontface = rep('plain', 7), fontfamily = rep('serif', 7), cat.pos = c(-40, 40, 180), cat.dist = c(0.05, 0.05, 0.025), cat.col = rep('black', 3), cat.cex = rep(1, 3), cat.fontface = rep('plain', 3), cat.fontfamily = rep('serif', 3), cat.just = list(c(0.5, 1), c(0.5, 1), c(0.5, 0)), cat.default.pos = 'outer', cat.prompts = FALSE, rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, sep.dist = 0.05, offset = 0, cex.prop=NULL, print.mode = 'raw', sigdigs=3, direct.area=FALSE, area.vector=0, ... ) { # area1 must be greater than area2, which must be greater than area3 # check parameter lengths if (length(category) == 1) {cat <- rep(category, 3); } else if (length(category) != 3) { flog.error('Unexpected parameter length for "category"',name='VennDiagramLogger') stop('Unexpected parameter length for "category"'); } if (length(lwd) == 1) { lwd <- rep(lwd, 3); } else if (length(lwd) != 3) { flog.error('Unexpected parameter length for "lwd"',name='VennDiagramLogger') stop('Unexpected parameter length for "lwd"'); } if (length(lty) == 1) { lty <- rep(lty, 3); } else if (length(lty) != 3) { flog.error('Unexpected parameter length for "lty"',name='VennDiagramLogger') stop('Unexpected parameter length for "lty"'); } if (length(col) == 1) { col <- rep(col, 3); } else if (length(col) != 3) { flog.error('Unexpected parameter length for "col"',name='VennDiagramLogger') stop('Unexpected parameter length for "col"'); } if (length(label.col) == 1) { label.col <- rep(label.col, 7); } else if (length(label.col) != 7) { flog.error('Unexpected parameter length for "label.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "label.col"'); } if (length(cex) == 1) { cex <- rep(cex, 7); } else if (length(cex) != 7) { flog.error('Unexpected parameter length for "cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cex"'); } if (length(fontface) == 1) { fontface <- rep(fontface, 7); } else if (length(fontface) != 7) { flog.error('Unexpected parameter length for "fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontface"'); } if (length(fontfamily) == 1) { fontfamily <- rep(fontfamily, 7); } else if (length(fontfamily) != 7) { flog.error('Unexpected parameter length for "fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontfamily"'); } if (length(fill) == 1) { fill <- rep(fill, 3); } else if (length(fill) != 3 & length(fill) != 0) { flog.error('Unexpected parameter length for "fill"',name='VennDiagramLogger') stop('Unexpected parameter length for "fill"'); } if (length(alpha) == 1) { alpha <- rep(alpha, 3); } else if (length(alpha) != 3 & length(alpha) != 0) { flog.error('Unexpected parameter length for "alpha"',name='VennDiagramLogger') stop('Unexpected parameter length for "alpha"'); } if (length(cat.pos) == 1) { cat.pos <- rep(cat.pos, 3); } else if (length(cat.pos) != 3) { flog.error('Unexpected parameter length for "cat.pos"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.pos"'); } if (length(cat.dist) == 1) { cat.dist <- rep(cat.dist, 3); } else if (length(cat.dist) != 3) { flog.error('Unexpected parameter length for "cat.dist"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.dist"'); } if (length(cat.col) == 1) { cat.col <- rep(cat.col, 3); } else if (length(cat.col) != 3) { flog.error('Unexpected parameter length for "cat.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.col"'); } if (length(cat.cex) == 1) { cat.cex <- rep(cat.cex, 3); } else if (length(cat.cex) != 3) { flog.error('Unexpected parameter length for "cat.cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.cex"'); } if (length(cat.fontface) == 1) { cat.fontface <- rep(cat.fontface, 3); } else if (length(cat.fontface) != 3) { flog.error('Unexpected parameter length for "cat.fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontface"'); } if (length(cat.fontfamily) == 1) { cat.fontfamily <- rep(cat.fontfamily, 3); } else if (length(cat.fontfamily) != 3) { flog.error('Unexpected parameter length for "cat.fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontfamily"'); } if (!(is.list(cat.just) & length(cat.just) == 3)) { flog.error('Unexpected parameter format for "cat.just"',name='VennDiagramLogger') stop('Unexpected parameter format for "cat.just"'); } else if (!(length(cat.just[[1]]) == 2 & length(cat.just[[2]]) == 2 & length(cat.just[[3]]) == 2)) { flog.error('Unexpected parameter format for "cat.just',name='VennDiagramLogger') stop('Unexpected parameter format for "cat.just"'); } # check uninterpretable parameter combination if (euler.d == FALSE & scaled == TRUE) { flog.error('Uninterpretable parameter combination\nPlease set both euler.d = FALSE and scaled = FALSE to force Venn diagrams.',name='VennDiagramLogger') stop('Uninterpretable parameter combination\nPlease set both euler.d = FALSE and scaled = FALSE to force Venn diagrams.'); } if (offset > 1 | offset < 0) { flog.error('Offset must be between 0 and 1. Try using "rotation.degree = 180" to achieve offsets in the opposite direction.',name='VennDiagramLogger') stop('Offset must be between 0 and 1. Try using "rotation.degree = 180" to achieve offsets in the opposite direction.'); } cat.pos <- cat.pos + rotation.degree; if(direct.area){ areas <- area.vector; #create the variables and assign their values from the area vector for(i in 1:7) { assign(paste('a',i,sep=''),area.vector[i]); } } else { # generate partial areas from given arguments a1 <- area1 - n12 - n13 + n123; a2 <- n12 - n123; a3 <- area2 - n12 - n23 + n123; a4 <- n13 - n123; a5 <- n123; a6 <- n23 - n123; a7 <- area3 - n13 - n23 + n123; areas <- c(a1, a2, a3, a4, a5, a6, a7); } # check for special cases and if necessary process them if (euler.d) { special.code <- VennDiagram::decide.special.case(areas); # did we define a special-case function for this case? if (special.code %in% c('121AO','100','033','011A','021AA','022AAOO','011O','112AA','122AAOO','010','110','130','001','012AA','120','022AAAO','032','111A','023')) { if (special.code %in% c('022AAAO', '022AAOO', '023', '032', '120', '121AO', '122AAOO', '130')) { f1 <- VennDiagram::draw.sp.case.scaled; } else { f1 <- VennDiagram::draw.sp.case.preprocess; } rst <- f1( sp.case.name = special.code, a1 = areas[1], a2 = areas[2], a3 = areas[3], a4 = areas[4], a5 = areas[5], a6 = areas[6], a7 = areas[7], category = category, reverse = reverse, cat.default.pos = cat.default.pos, lwd = lwd, lty = lty, col = col, label.col = label.col, cex = cex, fontface = fontface, fontfamily = fontfamily, cat.pos = cat.pos, cat.dist = cat.dist, cat.col = cat.col, cat.cex = cat.cex, cat.fontface = cat.fontface, cat.fontfamily = cat.fontfamily, cat.just = cat.just, cat.prompts = cat.prompts, fill = fill, alpha = alpha, print.mode = print.mode, sigdigs=sigdigs, ... ); # rotate the Venn diagram as needed rst <- VennDiagram::adjust.venn( VennDiagram::rotate.venn.degrees( gList1 = rst, angle = rotation.degree, x.centre = rotation.centre[1], y.centre = rotation.centre[2] ), ... ); # draw the diagram before returning gList if specified by user if (ind) { grid.draw(rst); } # exit the function here return(rst); } } rotated <- VennDiagram::rotate( areas, category, lwd, lty, col, label.col, cex, fontface, fontfamily, cat.col, cat.cex, cat.fontface, cat.fontfamily, alpha, rotation, reverse, fill ); for (i in 1:length(areas)) { areas[i] <- rotated[[1]][i]; } category <- rotated[[2]]; lwd <- rotated$lwd; lty <- rotated$lty; col <- rotated$col; label.col <- rotated$label.col; cex <- rotated$cex; fontface <- rotated$fontface; fontfamily <- rotated$fontfamily; cat.col <- rotated$cat.col; cat.cex <- rotated$cat.cex; cat.fontface <- rotated$cat.fontface; cat.fontfamily <- rotated$cat.fontfamily; fill <- rotated$fill; alpha <- rotated$alpha # check plausibility and 0 partial areas areas.error <- c( 'a1 <- area1 - n12 - n13 + n123', 'a2 <- n12 - n123', 'a3 <- area2 - n12 - n23 + n123', 'a4 <- n13 - n123', 'a5 <- n123', 'a6 <- n23 - n123', 'a7 <- area3 - n13 - n23 + n123' ); for (i in 1:length(areas)) { if (areas[i] < 0) { flog.error(paste('Impossible:', areas.error[i], 'produces negative area'),name='VennDiagramLogger') stop(paste('Impossible:', areas.error[i], 'produces negative area')); } } for (i in 1:length(areas)) { if (areas[i]) { scaled <- FALSE; } } # check if defaults are being used is.defaults <- TRUE; if (is.expression(category)) { is.defaults <- FALSE; } # check category label defaults if (all(cat.default.pos != 'outer', cat.default.pos != 'text', !is.defaults, cat.prompts)) { flog.info('No default location recognized. Automatically changing to "outer"',name='VennDiagramLogger'); cat.default.pos <- 'outer'; } if (all(cat.default.pos == 'outer', !is.defaults, cat.prompts)) { flog.info('Placing category labels at default outer locations. Use "cat.pos" and "cat.dist" to modify location.',name='VennDiagramLogger'); flog.info(paste('Current "cat.pos":', cat.pos[1], 'degrees,', cat.pos[2], 'degrees'),name='VennDiagramLogger'); flog.info(paste('Current "cat.dist":', cat.dist[1], ',', cat.dist[2]),name='VennDiagramLogger'); } if (all(cat.default.pos == 'text', !is.defaults, cat.prompts)) { flog.info('Placing category labels at default text locations. Use "cat.pos" and "cat.dist" to modify location.',name='VennDiagramLogger'); flog.info(paste('Current "cat.pos":', cat.pos[1], 'degrees,', cat.pos[2], 'degrees'),name='VennDiagramLogger'); flog.info(paste('Current "cat.dist":', cat.dist[1], ',', cat.dist[2]),name='VennDiagramLogger'); } # initialize gList to hold all Grobs generated grob.list <- gList(); # initialize radius values for all circles if (!exists('overrideTriple')) { r1 <- sqrt(100 / pi); r2 <- r1; r3 <- r1; } else { r1 <- sqrt(area1 / pi); r2 <- sqrt(area2 / pi); r3 <- sqrt(area3 / pi); } max.circle.size = 0.2; shrink.factor <- max.circle.size / r1; r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; if (!exists('overrideTriple')) { a <- find.dist(100, 100, 40) * shrink.factor; b <- a; c <- a; } else { a <- find.dist(area1, area2, n12) * shrink.factor; b <- find.dist(area2, area3, n23) * shrink.factor; c <- find.dist(area1, area3, n13) * shrink.factor; } # obtain the centres of the three circles based on their pairwise distances x.centres <- vector(mode = 'numeric', length = 3); y.centres <- vector(mode = 'numeric', length = 3); beta <- (a^2 + c^2 - b^2) / (2 * a * c); gamma <- sqrt(1 - beta^2); x.centres[1] <- (r1 - r2 - a + 1) / 2; x.centres[3] <- x.centres[1] + c * beta; y.centres[3] <- (r3 - r1 + 1 - c * gamma) / 2; y.centres[1] <- y.centres[3] + c * gamma; x.centres[2] <- x.centres[1] + a; y.centres[2] <- y.centres[1]; radii <- c(r1, r2, r3); # plot the circles of the Venn diagram for (i in 1:3) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = x.centres[i], y = y.centres[i], a = radii[i], b = radii[i], gp = gpar( lty = 0, fill = fill[i], alpha = alpha[i] ) ) ); } # plot the circle borders for (i in 1:3) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = x.centres[i], y = y.centres[i], a = radii[i], b = radii[i], gp = gpar( lwd = lwd[i], lty = lty[i], col = col[i], fill = 'transparent' ) ) ); } # calculate the location of the text labels new.x.centres <- vector(mode = 'numeric', length = 3); new.y.centres <- vector(mode = 'numeric', length = 3); cell.labels <- areas; cell.x <- vector(mode = 'numeric', length = 7); cell.y <- vector(mode = 'numeric', length = 7); x.cept.12 <- (r1^2 - r2^2 - x.centres[1]^2 + x.centres[2]^2) / (2 * (x.centres[2] - x.centres[1])) y.cept.12.1 <- sqrt(r1^2 - (x.cept.12 - x.centres[1])^2) + y.centres[1] y.cept.12.2 <- -sqrt(r1^2 - (x.cept.12 - x.centres[1])^2) + y.centres[1] theta <- acos((a^2 + c^2 - b^2) / (2 * a * c)); new.x.centres[3] <- x.centres[1] + c; l.x.cept.13 <- (r1^2 - r3^2 - x.centres[1]^2 + new.x.centres[3]^2) / (2 * (new.x.centres[3] - x.centres[1])); l.y.cept.13.1 <- sqrt(r1^2 - (l.x.cept.13 - x.centres[1])^2) + y.centres[1]; l.y.cept.13.2 <- -sqrt(r1^2 - (l.x.cept.13 - x.centres[1])^2) + y.centres[1]; rot <- sqrt(2 * r1^2 - 2 * r1^2 * cos(theta)); x.cept.13.1 <- l.x.cept.13 + rot * cos(pi / 2 - atan((l.y.cept.13.1 - y.centres[1]) / (l.x.cept.13 - x.centres[1])) + theta / 2); x.cept.13.2 <- l.x.cept.13 + rot * cos(pi / 2 - atan((l.y.cept.13.2 - y.centres[1]) / (l.x.cept.13 - x.centres[1])) + theta / 2); y.cept.13.1 <- l.y.cept.13.1 - rot * sin(pi / 2 - atan((l.y.cept.13.1 - y.centres[1]) / (l.x.cept.13 - x.centres[1])) + theta / 2); y.cept.13.2 <- l.y.cept.13.2 - rot * sin(pi / 2 - atan((l.y.cept.13.2 - y.centres[1]) / (l.x.cept.13 - x.centres[1])) + theta / 2); theta <- -acos((a^2 + b^2 - c^2) / (2 * a * b)); new.x.centres[3] <- x.centres[2] - b; l.x.cept.23 <- (r2^2 - r3^2 - x.centres[2]^2 + new.x.centres[3]^2) / (2 * (new.x.centres[3] - x.centres[2])); l.y.cept.23.1 <- sqrt(r2^2 - (l.x.cept.23 - x.centres[2])^2) + y.centres[2]; l.y.cept.23.2 <- -sqrt(r2^2 - (l.x.cept.23 - x.centres[2])^2) + y.centres[2]; rot <- sqrt(2 * r2^2 - 2 * r2^2 * cos(theta)); x.cept.23.1 <- l.x.cept.23 + rot * cos(pi / 2 - atan((y.centres[2] - l.y.cept.23.1) / (x.centres[2] - l.x.cept.23)) + theta / 2); x.cept.23.2 <- l.x.cept.23 + rot * cos(pi / 2 - atan((y.centres[2] - l.y.cept.23.2) / (x.centres[2] - l.x.cept.23)) + theta / 2); y.cept.23.1 <- l.y.cept.23.1 - rot * sin(pi / 2 - atan((y.centres[2] - l.y.cept.23.1) / (x.centres[2] - l.x.cept.23)) + theta / 2); y.cept.23.2 <- l.y.cept.23.2 - rot * sin(pi / 2 - atan((y.centres[2] - l.y.cept.23.2) / (x.centres[2] - l.x.cept.23)) + theta / 2); m <- (y.cept.23.2 - y.cept.23.1) / (x.cept.23.2 - x.cept.23.1); y.sect <- m * (x.cept.12 - x.cept.23.1) + y.cept.23.1; cell.x[5] <- x.cept.12; cell.y[5] <- y.sect; m <- (y.cept.13.2 - y.cept.13.1) / (x.cept.13.2 - x.cept.13.1); y0 <- y.centres[2]; x0 <- x.centres[2]; b <- y.cept.13.1 - m * x.cept.13.1; x.sect <- (m*y0 + x0 - m*b) / (m^2+1) + sqrt(r2^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); y.sect <- (m^2*y0 + m*x0 + b) / (m^2+1) + m * sqrt(r2^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); cell.x[3] <- (x.cept.13.1 + x.sect) / 2; cell.y[3] <- (y.cept.13.1 + y.sect) / 2; m <- (y.cept.23.2 - y.cept.23.1) / (x.cept.23.2 - x.cept.23.1); y0 <- y.centres[1]; x0 <- x.centres[1]; b <- y.cept.23.1 - m * x.cept.23.1; x.sect <- (m*y0 + x0 - m*b) / (m^2+1) - sqrt(r1^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); y.sect <- (m^2*y0 + m*x0 + b) / (m^2+1) - m * sqrt(r1^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); cell.x[1] <- (x.cept.23.1 + x.sect) / 2; cell.y[1] <- (y.cept.23.1 + y.sect) / 2; y.sect <- -sqrt(r3^2 - (x.cept.12 - x.centres[3])^2) + y.centres[3]; cell.x[7] <- x.cept.12; cell.y[7] <- (y.cept.12.2 + y.sect) / 2; m <- (y.cept.23.2 - y.cept.23.1) / (x.cept.23.2 - x.cept.23.1); y0 <- y.centres[1]; x0 <- x.centres[1]; b <- y.cept.23.1 - m * x.cept.23.1; x.sect <- (m*y0 + x0 - m*b) / (m^2+1) + sqrt(r1^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); y.sect <- (m^2*y0 + m*x0 + b) / (m^2+1) + m * sqrt(r1^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); cell.x[6] <- (x.cept.23.2 + x.sect) / 2; cell.y[6] <- (y.cept.23.2 + y.sect) / 2; m <- (y.cept.13.2 - y.cept.13.1) / (x.cept.13.2 - x.cept.13.1); y0 <- y.centres[2]; x0 <- x.centres[2]; b <- y.cept.13.1 - m * x.cept.13.1; x.sect <- (m*y0 + x0 - m*b) / (m^2+1) - sqrt(r2^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); y.sect <- (m^2*y0 + m*x0 + b) / (m^2+1) - m * sqrt(r2^2 - ( (y0-m*x0-b)/sqrt(1+m^2) )^2) / sqrt(1+m^2); cell.x[4] <- (x.cept.13.2 + x.sect) / 2; cell.y[4] <- (y.cept.13.2 + y.sect) / 2; y.sect <- sqrt(r3^2 - (x.cept.12 - x.centres[3])^2) + y.centres[3]; cell.x[2] <- x.cept.12; cell.y[2] <- (y.cept.12.1 + y.sect) / 2; ## rescaling area labels to be proportional to area if(length(cex.prop) > 0){ if(length(cex.prop) != 1) { flog.error('Value passed to cex.prop is not length 1',name='VennDiagramLogger') stop('Value passed to cex.prop is not length 1') } ## figure out what function to use func = cex.prop if (!is(cex.prop, 'function')) { if(cex.prop == 'lin'){ func = function(x) x } else if(cex.prop == 'log10'){ func = log10 } else flog.error(paste0('Unknown value passed to cex.prop: ', cex.prop),name='VennDiagramLogger') stop(paste0('Unknown value passed to cex.prop: ', cex.prop)) } ## rescale areas maxArea = max(areas) for(i in 1:length(areas)){ cex[i] = cex[i] * func(areas[i]) / func(maxArea) if(cex[i] <= 0) stop(paste0('Error in rescaling of area labels: the label of area ', i, ' is less than or equal to zero')) } } processedLabels <- rep('',length(cell.labels)); if(print.mode[1] == 'percent'){ processedLabels <- paste(signif(cell.labels/sum(cell.labels)*100,digits=sigdigs),'%',sep=''); if(isTRUE(print.mode[2] == 'raw')) { processedLabels <- paste(processedLabels,'\n(',cell.labels,')',sep=''); } } if(print.mode[1] == 'raw'){ processedLabels <- cell.labels; if(isTRUE(print.mode[2] == 'percent')) { processedLabels <- paste(processedLabels,'\n(',paste(signif(cell.labels/sum(cell.labels)*100,digits=sigdigs),'%)',sep=''),sep=''); } } for (i in 1:7) { grob.list <- gList( grob.list, textGrob( label = processedLabels[i], x = cell.x[i], y = cell.y[i], gp = gpar( col = label.col[i], cex = cex[i], fontface = fontface[i], fontfamily = fontfamily[i] ) ) ); } # plot all category names text.location.mapping <- c(1,3,7); for (i in 1:3) { # determine position if ('outer' == cat.default.pos) { this.cat.pos <- find.cat.pos( x = x.centres[i], y = y.centres[i], pos = cat.pos[i], dist = cat.dist[i], r = radii[i] ); } else if ('text' == cat.default.pos) { this.cat.pos <- find.cat.pos( x = cell.x[text.location.mapping[i]], y = cell.y[text.location.mapping[i]], pos = cat.pos[i], dist = cat.dist[i] ); } else { flog.error('Invalid setting of cat.default.pos',name='VennDiagramLogger') stop('Invalid setting of cat.default.pos'); } # create label grob.list <- gList( grob.list, textGrob( label = category[i], x = this.cat.pos$x, y = this.cat.pos$y, just = cat.just[[i]], gp = gpar( col = cat.col[i], cex = cat.cex[i], fontface = cat.fontface[i], fontfamily = cat.fontfamily[i] ) ) ); } # if requested, rotate the Venn Diagram grob.list <- VennDiagram::adjust.venn( VennDiagram::rotate.venn.degrees( gList1 = grob.list, angle = rotation.degree, x.centre = rotation.centre[1], y.centre = rotation.centre[2] ), ... ); # draw diagram before returning gList is specified by user if (ind) { grid.draw(grob.list); } return(grob.list); } VennDiagram/R/draw.sp.case.scaled.R0000644000176200001440000003006214221171123016506 0ustar liggesusers#Called if the sp.case.name is not one of these: 022AAAO, 022AAOO, 023, 032, 120, 121AO, 122AAOO, 130 #if(!sp.case.name %in% c('022AAAO', '022AAOO', '023', '032', '120', '121AO', '122AAOO', '130')) draw.sp.case.scaled <- function( sp.case.name, a1, a2, a3, a4, a5, a6, a7, category = rep('', 3), reverse = FALSE, cat.default.pos = 'outer', lwd = rep(2, 3), lty = rep('solid', 3), col = rep('black', 3), label.col = rep('black', 7), cex = rep(1, 7), fontface = rep('plain', 7), fontfamily = rep('serif', 7), cat.pos = c(-40, 40, 180), cat.dist = c(0.05, 0.05, 0.025), cat.col = rep('black', 3), cat.cex = rep(1, 3), cat.fontface = rep('plain', 3), cat.fontfamily = rep('serif', 3), cat.just = list(c(0.5, 1), c(0.5, 1), c(0.5, 0)), cat.prompts = FALSE, fill = NULL, alpha = rep(0.5, 3), scaled = TRUE, offset = 0, sep.dist = rep(0.05, 3), print.mode='raw', sigdigs=3, ... ) { if(sp.case.name == '130') { sep.dist = rep(0.05,3); } area.zeroes <- list('023' = c(1,3,4,6,7), '022AAOO' = c(1,3,4,6), '001' = c(7), '010' = c(2), '011O' = c(2,7), '100' = c(5), '112AA' = c(1,4,5,7), '021AA' = c(4,6,7), '012AA' = c(1,4,7), '122AAOO' = c(1,3,4,5,6), '033' = c(1,2,3,4,6,7), '120' = c(4,5,6), '022AAAO' = c(3,4,6,7), '111A' = c(4,5,7), '011A' = c(4,7), '130' = c(2,4,5,6), '032' = c(2,3,4,6,7), '121AO' = c(3,4,5,6), '110' = c(4,5)); area.labels <- list('012AA' = c(2,3,6), '122AAOO' = c(2,2,7), '033' = c(5,5,5), '120' = c(1,3,7), '022AAAO' = c(1,2,5), '111A' = c(1,3,6), '011A' = c(1,3,6), '130' = c(1,3,7), '032' = c(1,5,5), '121AO' = c(1,2,7), '110' = c(1,3,7), '023' = c(2,2,5), '022AAOO' = c(2,2,7), '001' = c(1,3,5), '010' = c(1,3,5), '011O' = c(1,3,5), '100' = c(1,3,7), '112AA' = c(2,3,6), '021AA' = c(1,3,5)); ######################Rotations #Need to check certain special rotations if(sp.case.name == '111A' || sp.case.name == '011A'){ for(i in 1:3){ tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), i, reverse); if (tmp$areas[7] == 0 & tmp$areas[4] == 0) { break; } if (tmp$areas[7] == 0 & tmp$areas[6] == 0) { tmp <- VennDiagram::rotate.sp(tmp$areas, 1, reverse = TRUE); break; } } } else if(sp.case.name == '121AO'){ #Need to check all possible rotations for (i in 1:6) { tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), (i-1) %% 3 + 1, reverse = (i>3)); if (0 == tmp$areas[3] & 0 == tmp$areas[4] & 0 == tmp$areas[5] & 0 == tmp$areas[6]) { break; } } } else if(sp.case.name == '022AAAO'){#Need to make sure reverse = FALSE for (i in 1:6) { tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), (i-1) %% 3 + 1, reverse = i>3); if (0 == tmp$areas[3] & 0 == tmp$areas[4] & 0 == tmp$areas[6] & 0 == tmp$areas[7]) { break; } } } else {#Normal rotations break.ind <- c(2,4,5,6);#Break if these tmp$areas are equal to zero #Get the break.ind by indexing a list by the sp.case.name break.ind <- area.zeroes[[sp.case.name]]; for (i in 1:3) { tmp <- VennDiagram::rotate.sp(c(a1, a2, a3, a4, a5, a6, a7), i, reverse); if (all(tmp$areas[break.ind]==0)) { break; } } } a1 <- tmp$areas[1]; a2 <- tmp$areas[2]; a3 <- tmp$areas[3]; a4 <- tmp$areas[4]; a5 <- tmp$areas[5]; a6 <- tmp$areas[6]; a7 <- tmp$areas[7]; # 3-vector rotations fill <- fill[tmp$o3]; cat.col <- cat.col[tmp$o3]; category <- category[tmp$o3]; lwd <- lwd[tmp$o3]; lty <- lty[tmp$o3]; col <- col[tmp$o3]; alpha <- alpha[tmp$o3]; cat.dist <- cat.dist[tmp$o3]; cat.cex <- cat.cex[tmp$o3]; cat.fontface <- cat.fontface[tmp$o3]; cat.fontfamily <- cat.fontfamily[tmp$o3]; cat.just <- cat.just[tmp$o3]; # 7-vector rotations label.col <- label.col[tmp$o7]; cex <- cex[tmp$o7]; fontface <- fontface[tmp$o7]; fontfamily <- fontfamily[tmp$o7]; a1.x.pos <- 0; a1.y.pos <- 0; a2.x.pos <- 0; a2.y.pos <- 0; a3.x.pos <- 0; a3.y.pos <- 0; a4.x.pos <- 0; a4.y.pos <- 0; a5.x.pos <- 0; a5.y.pos <- 0; a6.x.pos <- 0; a6.y.pos <- 0; a7.x.pos <- 0; a7.y.pos <- 0; ########### Calculations of [xy].centre[1-3] and a[1-7].[xy].pos ########### Calculate the areas, radii and positions for each case seperately if (sp.case.name == '022AAAO'){ if (scaled) { r1 <- sqrt((a1 + a2 + a5) / pi); r2 <- sqrt((a2 + a5) / pi); r3 <- sqrt(a5 / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; } else { r1 <- 0.4; r2 <- 0.25; r3 <- 0.1; } x.centre.1 <- 0.5; y.centre.1 <- 0.5; x.centre.2 <- 0.5 - offset * (r1 - r2); y.centre.2 <- 0.5; x.centre.3 <- 0.5 - offset * (r1 - r3); y.centre.3 <- 0.5; a1.x.pos <- (1 + r2 - offset * (r1 - r2) + r1) / 2; a1.y.pos <- 0.5; a2.x.pos <- (1 + r3 - offset * (r1 - r3) + r2 - offset * (r1 - r2)) / 2; a2.y.pos <- 0.5; a5.x.pos <- x.centre.3; a5.y.pos <- 0.5; } else if (sp.case.name == '022AAOO'){ if (scaled) { if (a2 >= a7) { d <- find.dist((a2 + a5), (a7 + a5), a5) } else { d <- find.dist((a7 + a5), (a2 + a5), a5) } r1 <- sqrt((a2 + a5) / pi); r2 <- sqrt((a2 + a5) / pi); r3 <- sqrt((a5 + a7) / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; d <- d * shrink.factor; } else { r1 <- 0.2; r2 <- 0.2; r3 <- 0.2; d <- 0.2; } x.centre.1 <- (1 + r1 - r2 - d) / 2; y.centre.1 <- 0.5; x.centre.2 <- x.centre.1; y.centre.2 <- 0.5; x.centre.3 <- x.centre.1 + d; y.centre.3 <- 0.5; a2.x.pos <- (x.centre.1 + x.centre.3 - r1 - r3) / 2; a2.y.pos <- 0.5; a5.x.pos <- (x.centre.1 + x.centre.3 + r1 - r3) / 2; a5.y.pos <- 0.5; a7.x.pos <- (x.centre.1 + x.centre.3 + r1 + r3) / 2; a7.y.pos <- 0.5; } else if (sp.case.name == '023'){ if (scaled) { r1 <- sqrt((a2 + a5) / pi); r2 <- sqrt(a5 / pi); r3 <- sqrt((a2 + a5) / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; } else { r1 <- 0.4; r2 <- 0.2; r3 <- 0.4; } x.centre.1 <- 0.5; y.centre.1 <- 0.5; x.centre.2 <- 0.5 - offset * (r1 - r2); y.centre.2 <- 0.5; x.centre.3 <- 0.5; y.centre.3 <- 0.5; a2.x.pos <- (x.centre.1 + x.centre.2 + r1 + r2) / 2; a2.y.pos <- 0.5; a5.x.pos <- x.centre.2; a5.y.pos <- 0.5; } else if (sp.case.name == '032'){ if (scaled) { r1 <- sqrt((a1 + a5) / pi); r2 <- sqrt(a5 / pi); r3 <- sqrt(a5 / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; } else { r1 <- 0.4; r2 <- 0.2; r3 <- 0.2; } x.centre.1 <- 0.5; y.centre.1 <- 0.5; x.centre.2 <- 0.5 - offset * (r1 - r2); y.centre.2 <- 0.5; x.centre.3 <- 0.5 - offset * (r1 - r3); y.centre.3 <- 0.5; a1.x.pos <- (x.centre.1 + x.centre.2 + r1 + r2) / 2; a1.y.pos <- 0.5; a5.x.pos <- x.centre.2; a5.y.pos <- 0.5; } else if (sp.case.name == '120'){ if (scaled) { if (a1 >= a3) { d <- find.dist(a1 + a2, a3 + a2, a2); } if (a1 < a3) { d <- find.dist(a3 + a2, a1 + a2, a2); } r1 <- sqrt((a1 + a2) / pi); r2 <- sqrt((a3 + a2) / pi); r3 <- sqrt(a7 / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; d <- d * shrink.factor; } else { r1 <- 0.2; r2 <- 0.2; r3 <- 0.2; d <- 0.2; } upper.y <- 0.66; lower.x <- 0.5; x.centre.1 <- (1 + r1 - r2 - d) / 2; x.centre.2 <- x.centre.1 + d; y.centre.1 <- upper.y; y.centre.2 <- upper.y; x.centre.3 <- lower.x; if (scaled) { if (a1 >= a3) { y.centre.3 <- y.centre.1 - sqrt(((r1 + r3) * (1 + sep.dist))^ 2 - (x.centre.1 - x.centre.3) ^2); } if (a1 < a3) { y.centre.3 <- y.centre.2 - sqrt(((r2 + r3) * (1 + sep.dist)) ^ 2 - (x.centre.2 - x.centre.3) ^2); } } else { if (a1 >= a3) { y.centre.3 <- y.centre.1 - sqrt((r1 + r3 + 0.03) ^ 2 - (x.centre.1 - x.centre.3) ^2); } if (a1 < a3) { y.centre.3 <- y.centre.2 - sqrt((r2 + r3 + 0.03) ^ 2 - (x.centre.2 - x.centre.3) ^2); } } a1.x.pos <- (x.centre.1 + x.centre.2 - r1 - r2) / 2; a1.y.pos <- upper.y; a3.x.pos <- (x.centre.1 + x.centre.2 + r1 + r2) / 2; a3.y.pos <- upper.y; a2.x.pos <- (x.centre.1 + x.centre.2 + r1 - r2) / 2; a2.y.pos <- upper.y; a7.x.pos <- x.centre.3; a7.y.pos <- y.centre.3; } else if (sp.case.name == '121AO'){ if (scaled) { r1 <- sqrt((a1 + a2) / pi); r2 <- sqrt(a2 / pi); r3 <- sqrt(a7 / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; } else { r1 <- 0.2; r2 <- 0.1; r3 <- 0.2; } x.centre.1 <- r1; y.centre.1 <- 0.5; x.centre.2 <- x.centre.1 - offset * (r1 - r2); y.centre.2 <- 0.5; x.centre.3 <- x.centre.1 + (1 + sep.dist) * (r1 + r3); y.centre.3 <- 0.5; a1.x.pos <- ((x.centre.1 - r1) + (x.centre.2 - r2)) / 2; a1.y.pos <- 0.5; a2.x.pos <- x.centre.1; a2.y.pos <- 0.5; a7.x.pos <- x.centre.3; a7.y.pos <- 0.5; } else if (sp.case.name == '122AAOO'){ if (scaled) { r1 <- sqrt(a2 / pi); r2 <- sqrt(a2 / pi); r3 <- sqrt(a7 / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; } else { r1 <- 0.2; r2 <- 0.2; r3 <- 0.2; } x.centre.1 <- r1; y.centre.1 <- 0.5; x.centre.2 <- r1; y.centre.2 <- 0.5; x.centre.3 <- r1 + (1 + sep.dist) * (r1 + r3); y.centre.3 <- 0.5; a2.x.pos <- x.centre.1; a2.y.pos <- 0.5; a7.x.pos <- x.centre.3; a7.y.pos <- 0.5; } else if (sp.case.name == '130'){ if (scaled) { r1 <- sqrt(a1 / pi); r2 <- sqrt(a3 / pi); r3 <- sqrt(a7 / pi); shrink.factor <- 0.2 / max(r1, r2, r3); r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; r3 <- r3 * shrink.factor; } else { r1 <- 0.18; r2 <- 0.18; r3 <- 0.18; } a <- (r1 + r2) * (1 + sep.dist[1]); b <- (r2 + r3) * (1 + sep.dist[2]); c <- (r1 + r3) * (1 + sep.dist[3]); beta <- (a^2 + c^2 - b^2) / (2 * a * c); gamma <- sqrt(1 - beta^2); x.centre.1 <- (r1 - r2 - a + 1) / 2; x.centre.3 <- x.centre.1 + c * beta; y.centre.3 <- (r3 - r1 + 1 - c * gamma) / 2; y.centre.1 <- y.centre.3 + c * gamma; x.centre.2 <- x.centre.1 + a; y.centre.2 <- y.centre.1; a1.x.pos <- x.centre.1; a1.y.pos <- y.centre.1; a3.x.pos <- x.centre.2; a3.y.pos <- y.centre.2; a7.x.pos <- x.centre.3; a7.y.pos <- y.centre.3; } else { flog.info(paste0('The special case is not in the scaled cases: ',sp.case.name),name='VennDiagramLogger'); } a.list = c(r1, r2, r3); b.list = c(r1, r2, r3); if(sp.case.name == '001' || sp.case.name == '011O') { a.list = c(r1,r2,0.25); if(sp.case.name == '001') { b.list = c(r1,r2,0.18); } else {#sp.case.name == '011O' b.list = c(r1,r2,0.2); } } if(!sp.case.name %in% c('011A','022AAAO','023','032','033','111A','121AO')) { reverse = FALSE; } straight.reverse = FALSE; if(!sp.case.name %in% c('011A','022AAAO','022AAOO','111A','120','121AO','122AAOO')) { straight.reverse = TRUE; } return( VennDiagram::draw.sp.case( area.list = c(a1, a2, a3, a4, a5, a6, a7), enabled.areas = setdiff(1:7,unlist(area.zeroes[sp.case.name])),#The enabled areas are those with non-zero areas area.x = c(a1.x.pos, a2.x.pos, a3.x.pos, a4.x.pos, a5.x.pos, a6.x.pos, a7.x.pos), area.y = c(a1.y.pos, a2.y.pos, a3.y.pos, a4.y.pos, a5.y.pos, a6.y.pos, a7.y.pos), attach.label.to = area.labels[[sp.case.name]], x.centres = c(x.centre.1, x.centre.2, x.centre.3), y.centres = c(y.centre.1, y.centre.2, y.centre.3), a.list = a.list, b.list = b.list, straight.reverse = straight.reverse, reverse = reverse, category = category, cat.default.pos = cat.default.pos, lwd = lwd, lty = lty, col = col, label.col = label.col, cex = cex, fontface = fontface, fontfamily = fontfamily, cat.pos = cat.pos, cat.dist = cat.dist, cat.col = cat.col, cat.cex = cat.cex, cat.fontface = cat.fontface, cat.fontfamily = cat.fontfamily, cat.just = cat.just, fill = fill, alpha = alpha, print.mode=print.mode, sigdigs=sigdigs, ... ) ); } VennDiagram/R/find.intersect.R0000644000176200001440000000271314112260207015706 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. # find the intersection of two circles find.intersect <- function(d, r1, r2) { beta <- (r1^2 + d^2 - r2^2) / (2 * r1 * d); gamma <- (r2^2 + d^2 - r1^2) / (2 * r2 * d); area <- r1^2 * (acos(beta) - 0.5 * sin(2 * acos(beta))) + r2^2 * (acos(gamma) - 0.5 * sin(2 * acos(gamma))); return(area); } VennDiagram/R/rotate.R0000644000176200001440000000531314122450766014300 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. # rotate & reverse triple Venn diagrams rotate <- function( area.vector, category.vector, lwd, lty, col, label.col, cex, fontface, fontfamily, cat.col, cat.cex, cat.fontface, cat.fontfamily, alpha, rotation, reverse, fill = NULL ) { rot.1.f.7 <- 1:7; rot.1.f.3 <- 1:3; rot.1.r.7 <- c(3,2,1,6,5,4,7); rot.1.r.3 <- c(2,1,3); rot.2.f.7 <- c(3,6,7,2,5,4,1); rot.2.f.3 <- c(2,3,1); rot.2.r.7 <- c(7,6,3,4,5,2,1); rot.2.r.3 <- c(3,2,1); rot.3.f.7 <- c(7,4,1,6,5,2,3); rot.3.f.3 <- c(3,1,2); rot.3.r.7 <- c(1,4,7,2,5,6,3); rot.3.r.3 <- c(1,3,2); if (reverse) { if (1 == rotation) { order.7 <- rot.1.r.7; order.3 <- rot.1.r.3; } else if (2 == rotation) { order.7 <- rot.2.r.7; order.3 <- rot.2.r.3; } else if (3 == rotation) { order.7 <- rot.3.r.7; order.3 <- rot.3.r.3; } } else { if (1 == rotation) { order.7 <- rot.1.f.7; order.3 <- rot.1.f.3; } else if (2 == rotation) { order.7 <- rot.2.f.7; order.3 <- rot.2.f.3; } else if (3 == rotation) { order.7 <- rot.3.f.7; order.3 <- rot.3.f.3; } } return( list( a = area.vector[order.7], c = category.vector[order.3], lwd = lwd[order.3], lty = lty[order.3], col = col[order.3], label.col = label.col[order.7], cex = cex[order.7], fontface = fontface[order.7], fontfamily = fontfamily[order.7], cat.col = cat.col[order.3], cat.cex = cat.cex[order.3], cat.fontface = cat.fontface[order.3], cat.fontfamily = cat.fontfamily[order.3], fill = fill[order.3], alpha = alpha[order.3] ) ); } VennDiagram/R/draw.single.venn.R0000644000176200001440000001611714225106152016157 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW VENN DIAGRAM WITH A SINGLE SET ############################################### draw.single.venn <- function( area, category = '', lwd = 2, lty = 'solid', col = 'black', fill = NULL, alpha = 0.5, label.col = 'black', cex = 1, fontface = 'plain', fontfamily = 'serif', cat.pos = 0, cat.dist = 0.025, cat.cex = 1, cat.col = 'black', cat.fontface = 'plain', cat.fontfamily = 'serif', cat.just = list(c(0.5, 0.5)), cat.default.pos = 'outer', cat.prompts = FALSE, rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, ... ) { # check parameter lengths if (length(category) != 1) { flog.error('Unexpected parameter length for "category"',name='VennDiagramLogger') stop('Unexpected parameter length for "category"'); } if (length(lwd) != 1) { flog.error('Unexpected parameter length for "lwd"',name='VennDiagramLogger') stop('Unexpected parameter length for "lwd"'); } if (length(lty) != 1) { flog.error('Unexpected parameter length for "lty"',name='VennDiagramLogger') stop('Unexpected parameter length for "lty"'); } if (length(col) != 1) { flog.error('Unexpected parameter length for "col"',name='VennDiagramLogger') stop('Unexpected parameter length for "col"'); } if (length(label.col) != 1) { flog.error('Unexpected parameter length for "label.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "label.col"'); } if (length(cex) != 1) { flog.error('Unexpected parameter length for "cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cex"'); } if (length(fontface) != 1) { flog.error('Unexpected parameter length for "fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontface"'); } if (length(fontfamily) != 1) { flog.error('Unexpected parameter length for "fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontfamily"'); } if (length(fill) != 1 & length(fill) != 0) { flog.error('Unexpected parameter length for "fill"',name='VennDiagramLogger') stop('Unexpected parameter length for "fill"'); } if (length(alpha) != 1 & length(alpha) != 0) { flog.error('Unexpected parameter length for "alpha"',name='VennDiagramLogger') stop('Unexpected parameter length for "alpha"'); } if (length(cat.pos) != 1) { flog.error('Unexpected parameter length for "cat.pos"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.pos"'); } if (length(cat.dist) != 1) { flog.error('Unexpected parameter length for "cat.dist"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.dist"'); } if (length(cat.col) != 1) { flog.error('Unexpected parameter length for "cat.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.col"'); } if (length(cat.cex) != 1) { flog.error('Unexpected parameter length for "cat.cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.cex"'); } if (length(cat.fontface) != 1) { flog.error('Unexpected parameter length for "cat.fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontface"'); } if (length(cat.fontfamily) != 1) { flog.error('Unexpected parameter length for "cat.fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontfamily"'); } if (!(is.list(cat.just) && length(cat.just) == 1 && length(cat.just[[1]]) == 2)) { flog.error('Unexpected parameter format for "cat.just"',name='VennDiagramLogger') stop('Unexpected parameter format for "cat.just"'); } cat.pos <- cat.pos + rotation.degree; # check category label defaults if (cat.default.pos != 'outer' & cat.default.pos != 'text' & category != '' & cat.prompts) { flog.info('No default location recognized. Automatically changing to "outer"',name='VennDiagramLogger'); cat.default.pos <- 'outer'; } if (cat.default.pos == 'outer' & category != '' & cat.prompts) { flog.info('Placing category labels at default outer locations. Use "cat.pos" and "cat.dist" to modify location.',name='VennDiagramLogger'); flog.info(paste('Current "cat.pos":', cat.pos, 'degrees'),name='VennDiagramLogger'); flog.info(paste('Current "cat.dist":', cat.dist),name='VennDiagramLogger'); } if (cat.default.pos == 'text' & category != '' & cat.prompts) { flog.info('Placing category labels at default text locations. Use "cat.pos" and "cat.dist" to modify location.',name='VennDiagramLogger'); flog.info(paste('Current "cat.pos":', cat.pos, 'degrees'),name='VennDiagramLogger'); flog.info(paste('Current "cat.dist":', cat.dist),name='VennDiagramLogger'); } max.circle.size = 0.2; # obtain radius corresponding to the circle with given area and convert it to Grid dimensions r1 <- sqrt(area / pi); shrink.factor <- max.circle.size / r1; r1 <- r1 * shrink.factor; # initialize gList to hold all Grobs generated grob.list <- gList(); # plot Venn diagram tmp <- VennDiagram::ellipse( x = 0.5, y = 0.5, a = r1, b = r1, gp = gpar( lty = 0, fill = fill, alpha = alpha ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.5, y = 0.5, a = r1, b = r1, gp = gpar( lwd = lwd, lty = lty, col = col, fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = area, x = 0.5, y = 0.5, gp = gpar( col = label.col, cex = cex, fontface = fontface, fontfamily = fontfamily ) ); grob.list <- gList(grob.list, tmp); if (cat.default.pos == 'outer') { cat.pos.1 <- find.cat.pos(0.5, 0.5, cat.pos, cat.dist, r1) } if (cat.default.pos == 'text') { cat.pos.1 <- find.cat.pos(0.5, 0.5, cat.pos, cat.dist) } tmp <- textGrob( label = category, x = cat.pos.1$x, y = cat.pos.1$y, just = cat.just[[1]], gp = gpar( col = cat.col, cex = cat.cex, fontface = cat.fontface, fontfamily = cat.fontfamily ) ); grob.list <- gList(grob.list, tmp); grob.list <- VennDiagram::adjust.venn(VennDiagram::rotate.venn.degrees(grob.list, rotation.degree, rotation.centre[1], rotation.centre[2]), ...); if (ind) { grid.draw(grob.list); } return(grob.list); } VennDiagram/R/decide.special.case.R0000644000176200001440000000724514221171123016541 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DECIDE TRIPLE SET SPECIAL CASES (EULER DIAGRAMS) ################################## decide.special.case <- function(areas) { # returns a code of the form \d{3}\w{0,4} (I'm using Perl regex here for clarity) # first digit is 1 if the overlap is missing (a5 = 0), 0 if it is there (a5 > 0) # second digit is how many double overlaps are missing (determined by a2, a4, a6) # third digit is how many distinct sections are missing (determined by a1, a3, a7) # there will be (second digit)*(third digit) letters in the code, but all N's will be removed # N = Normal plot, and N is removed from the return code # A = zeroes in the double overlap and distinct sections are Adjacent # O = zeroes in the double overlap and distinct sections are Opposite # the ordering of the letters has no meaning, it is simply sorted for clarity ao.1 <- c('N', 'A', 'N', 'A', 'N', 'O', 'N'); ao.2 <- c('A', 'N', 'A', 'N', 'N', 'N', 'O'); ao.3 <- c('N', 'A', 'N', 'O', 'N', 'A', 'N'); ao.4 <- c('A', 'N', 'O', 'N', 'N', 'N', 'A'); ao.5 <- c('N', 'N', 'N', 'N', 'N', 'N', 'N'); ao.6 <- c('O', 'N', 'A', 'N', 'N', 'N', 'A'); ao.7 <- c('N', 'O', 'N', 'A', 'N', 'A', 'N'); ao.matrix <- rbind(ao.1, ao.2, ao.3, ao.4, ao.5, ao.6, ao.7); vector.137 <- c(areas[1], areas[3], areas[7]); vector.246 <- c(areas[2], areas[4], areas[6]); # determine what overlaps occur in the Venn first.pos <- length(c(areas[5])[c(areas[5]) == 0]); second.pos <- length(vector.246[vector.246 == 0]); third.pos <- length(vector.137[vector.137 == 0]); fourth.vector <- c(''); # make changes to positions if missing double or triple overlaps and all three are not mutually exclusive if (second.pos >= 1 & third.pos >= 1 & second.pos < 3 & third.pos < 3) { # indices of what areas are missing second.indices <- c(2,4,6)[vector.246 == 0]; third.indices <- c(1,3,7)[vector.137 == 0]; combns <- combn(c(second.indices, third.indices), 2, simplify = FALSE); fourth.vector <- vector(length = length(combns), mode = 'character'); for (i in 1:length(combns)) { # read entry in ao.matrix corresponding to the current indicies fourth.vector[i] <- ao.matrix[combns[[i]][1], combns[[i]][2]] } fourth.vector <- fourth.vector[fourth.vector != 'N'] } fourth.vector <- sort(fourth.vector); accum <- ''; # add A's or O's to accum to specify what draw.'rst'.R function should be called for (i in 1:length(fourth.vector)) { accum <- paste(accum, fourth.vector[i], sep = ''); } rst <- paste(first.pos, second.pos, third.pos, accum, sep = ''); return(rst); } VennDiagram/R/adjust.venn.R0000644000176200001440000000534514112260207015232 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO FIT VENN DIAGRAM TO SIZE ########################################################## adjust.venn <- function(gList1, margin = 0.01, ...) { # adjusts the positions of the ellipses to account for changes made to the plot so far # vectors containing all the data sequentially x.vect <- vector(); y.vect <- vector(); # list containing each vector in x.vect and y.vect x.list <- list(); y.list <- list(); for (i in 1:length(gList1)) { x.vect <- c(x.vect, as.vector(gList1[i][[1]]$x, mode = 'numeric')); y.vect <- c(y.vect, as.vector(gList1[i][[1]]$y, mode = 'numeric')); x.list[[i]] <- as.vector(gList1[i][[1]]$x, mode = 'numeric'); y.list[[i]] <- as.vector(gList1[i][[1]]$y, mode = 'numeric'); } # get dimensions of ellipses max.x <- max(x.vect) + margin; min.x <- min(x.vect) - margin; max.y <- max(y.vect) + margin; min.y <- min(y.vect) - margin; x.centre <- (max.x + min.x) / 2; y.centre <- (max.y + min.y) / 2; size <- 0.99; # wider than tall if (max.x - min.x >= max.y - min.y) { for (i in 1:length(x.list)) { x.list[[i]] <- unit((x.list[[i]] - x.centre) * (size / (max.x - min.x)) + 0.5, 'npc'); y.list[[i]] <- unit((y.list[[i]] - y.centre) * (size / (max.x - min.x)) + 0.5, 'npc'); } } else { for (i in 1:length(x.list)) { x.list[[i]] <- unit((x.list[[i]] - x.centre) * (size / (max.y - min.y)) + 0.5, 'npc'); y.list[[i]] <- unit((y.list[[i]] - y.centre) * (size / (max.y - min.y)) + 0.5, 'npc'); } } for (i in 1:length(gList1)) { gList1[i][[1]]$x <- x.list[[i]]; gList1[i][[1]]$y <- y.list[[i]]; } return(gList1); } VennDiagram/R/venn.diagram.R0000644000176200001440000004302314221171123015336 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### UMBRELLA FUNCTION TO DRAW VENN DIAGRAMS ####################################################### venn.diagram <- function( x, filename, disable.logging = FALSE, height = 3000, width = 3000, resolution = 500, imagetype = 'tiff', units = 'px', compression = 'lzw', na = 'stop', main = NULL, sub = NULL, main.pos = c(0.5, 1.05), main.fontface = 'plain', main.fontfamily = 'serif', main.col = 'black', main.cex = 1, main.just = c(0.5, 1), sub.pos = c(0.5, 1.05), sub.fontface = 'plain', sub.fontfamily = 'serif', sub.col = 'black', sub.cex = 1, sub.just = c(0.5, 1), category.names = names(x), force.unique = TRUE, print.mode = 'raw', sigdigs = 3, direct.area = FALSE, area.vector = 0, hyper.test = FALSE, total.population = NULL, lower.tail = TRUE, ... ) { #Create a string to capture the date and the time of day time.string = gsub(':', '-', gsub(' ', '_', as.character(Sys.time()))) #Initialize the logger to output to file if (disable.logging) { flog.appender(appender.console(), name = 'VennDiagramLogger'); } else { flog.appender(appender.file( paste0(if (!is.null(filename)) filename else 'VennDiagram', '.', time.string, '.log')), name = 'VennDiagramLogger' ); } #Log the parameters the function was called with out.list = as.list(sys.call()) out.list[[1]] <- NULL out.string = capture.output(out.list) flog.info(out.string,name='VennDiagramLogger') #If the input area.vector correspond directly to a1,a2, etc, then call the function and pass it through directly by a flag if(direct.area){ if(1 == length(area.vector)){ list.names <- category.names; if (is.null(list.names)) { list.names <- ''; } grob.list <- VennDiagram::draw.single.venn( area = area.vector[1], category = list.names, ind = FALSE, ... ); } if(3 == length(area.vector)){ grob.list <- VennDiagram::draw.pairwise.venn( area1 = area.vector[1], area2 = area.vector[2], cross.area = area.vector[3], category = category.names, ind = FALSE, print.mode=print.mode, sigdigs=sigdigs, ... ); } if(7 == length(area.vector)){ grob.list <- VennDiagram::draw.triple.venn( area1 = 0, area2 = 0, area3 = 0, n12 = 0, n23 = 0, n13 = 0, n123 = 0, category = category.names, ind = FALSE, list.order = 1:3, print.mode=print.mode, sigdigs=sigdigs, area.vector=area.vector, direct.area=TRUE, ... ); } if(15 == length(area.vector)){ grob.list <- VennDiagram::draw.quad.venn( area1 = 0, area2 = 0, area3 = 0, area4 = 0, n12 = 0, n13 = 0, n14 = 0, n23 = 0, n24 = 0, n34 = 0, n123 = 0, n124 = 0, n134 = 0, n234 = 0, n1234 = 0, category = category.names, ind = FALSE, print.mode=print.mode, sigdigs=sigdigs, area.vector=area.vector, direct.area=TRUE, ... ); } if(31 == length(area.vector)){ grob.list <- VennDiagram::draw.quintuple.venn( area1 = 0, area2 = 0, area3 = 0, area4 = 0, area5 = 0, n12 = 0, n13 = 0, n14 = 0, n15 = 0, n23 = 0, n24 = 0, n25 = 0, n34 = 0, n35 = 0, n45 = 0, n123 = 0, n124 = 0, n125 = 0, n134 = 0, n135 = 0, n145 = 0, n234 = 0, n235 = 0, n245 = 0, n345 = 0, n1234 = 0, n1235 = 0, n1245 = 0, n1345 = 0, n2345 = 0, n12345 = 0, category = category.names, ind = FALSE, print.mode=print.mode, sigdigs=sigdigs, area.vector=area.vector, direct.area=TRUE, ... ); } } #Use default processing behaviour of having individual elements in the list x else{ if (force.unique) { for (i in 1:length(x)) { x[[i]] <- unique(x[[i]]) } } # check for the presence of NAs in the input list if ('none' == na) { x <- x; } else if ('stop' == na) { for (i in 1:length(x)) { # stop if there are any NAs in this vector if (any(is.na(x[[i]]))) { flog.error('NAs in dataset', call. = FALSE,name='VennDiagramLogger') stop('NAs in dataset', call. = FALSE); } } } else if ('remove' == na) { for (i in 1:length(x)) { x[[i]] <- x[[i]][!is.na(x[[i]])]; } } else { flog.error('Invalid na option: valid options are "none", "stop", and "remove"',name='VennDiagramLogger') stop('Invalid na option: valid options are "none", "stop", and "remove"'); } # check the length of the given list if (0 == length(x) | length(x) > 5) { flog.error('Incorrect number of elements.', call. = FALSE,name='VennDiagramLogger') stop('Incorrect number of elements.', call. = FALSE); } # draw a single-set Venn diagram if (1 == length(x)) { list.names <- category.names; if (is.null(list.names)) { list.names <- ''; } grob.list <- VennDiagram::draw.single.venn( area = length(x[[1]]), category = list.names, ind = FALSE, ... ); } # draw a pairwise Venn diagram else if (2 == length(x)) { grob.list <- VennDiagram::draw.pairwise.venn( area1 = length(x[[1]]), area2 = length(x[[2]]), cross.area = length(intersect(x[[1]],x[[2]])), category = category.names, ind = FALSE, print.mode=print.mode, sigdigs=sigdigs, ... ); } # draw a three-set Venn diagram else if (3 == length(x)) { A <- x[[1]]; B <- x[[2]]; C <- x[[3]]; list.names <- category.names; nab <- intersect(A, B); nbc <- intersect(B, C); nac <- intersect(A, C); nabc <- intersect(nab, C); grob.list <- VennDiagram::draw.triple.venn( area1 = length(A), area2 = length(B), area3 = length(C), n12 = length(nab), n23 = length(nbc), n13 = length(nac), n123 = length(nabc), category = list.names, ind = FALSE, list.order = 1:3, print.mode=print.mode, sigdigs=sigdigs, ... ); } # draw a four-set Venn diagram else if (4 == length(x)) { A <- x[[1]]; B <- x[[2]]; C <- x[[3]]; D <- x[[4]]; list.names <- category.names; n12 <- intersect(A, B); n13 <- intersect(A, C); n14 <- intersect(A, D); n23 <- intersect(B, C); n24 <- intersect(B, D); n34 <- intersect(C, D); n123 <- intersect(n12, C); n124 <- intersect(n12, D); n134 <- intersect(n13, D); n234 <- intersect(n23, D); n1234 <- intersect(n123, D); grob.list <- VennDiagram::draw.quad.venn( area1 = length(A), area2 = length(B), area3 = length(C), area4 = length(D), n12 = length(n12), n13 = length(n13), n14 = length(n14), n23 = length(n23), n24 = length(n24), n34 = length(n34), n123 = length(n123), n124 = length(n124), n134 = length(n134), n234 = length(n234), n1234 = length(n1234), category = list.names, ind = FALSE, print.mode=print.mode, sigdigs=sigdigs, ... ); } # draw a five-set Venn diagram else if (5 == length(x)) { A <- x[[1]]; B <- x[[2]]; C <- x[[3]]; D <- x[[4]]; E <- x[[5]]; list.names <- category.names; n12 <- intersect(A, B); n13 <- intersect(A, C); n14 <- intersect(A, D); n15 <- intersect(A, E); n23 <- intersect(B, C); n24 <- intersect(B, D); n25 <- intersect(B, E); n34 <- intersect(C, D); n35 <- intersect(C, E); n45 <- intersect(D, E); n123 <- intersect(n12, C); n124 <- intersect(n12, D); n125 <- intersect(n12, E); n134 <- intersect(n13, D); n135 <- intersect(n13, E); n145 <- intersect(n14, E); n234 <- intersect(n23, D); n235 <- intersect(n23, E); n245 <- intersect(n24, E); n345 <- intersect(n34, E); n1234 <- intersect(n123, D); n1235 <- intersect(n123, E); n1245 <- intersect(n124, E); n1345 <- intersect(n134, E); n2345 <- intersect(n234, E); n12345 <- intersect(n1234, E); grob.list <- VennDiagram::draw.quintuple.venn( area1 = length(A), area2 = length(B), area3 = length(C), area4 = length(D), area5 = length(E), n12 = length(n12), n13 = length(n13), n14 = length(n14), n15 = length(n15), n23 = length(n23), n24 = length(n24), n25 = length(n25), n34 = length(n34), n35 = length(n35), n45 = length(n45), n123 = length(n123), n124 = length(n124), n125 = length(n125), n134 = length(n134), n135 = length(n135), n145 = length(n145), n234 = length(n234), n235 = length(n235), n245 = length(n245), n345 = length(n345), n1234 = length(n1234), n1235 = length(n1235), n1245 = length(n1245), n1345 = length(n1345), n2345 = length(n2345), n12345 = length(n12345), category = list.names, ind = FALSE, print.mode=print.mode, sigdigs=sigdigs, ... ); } # this should never happen because of the previous check else { flog.error('Invalid size of input object',name='VennDiagramLogger') stop('Invalid size of input object'); } } # if there are two sets in the VennDiagram and the hypergeometric test is requested then perform the test and add the pvalue to the subtitle #p value always shown with 2 sig digs. Add another parameter for this later if you want to control the sig digs if (length(x) == 2 & !is.null(total.population) & hyper.test){ val.p = calculate.overlap.and.pvalue(x[[1]],x[[2]],total.population, lower.tail = lower.tail); if(is.null(sub)){ sub = paste0('p = ',signif(val.p[3],digits=2)) }else{ sub = paste0(sub,', p = ',signif(val.p[3],digits=2)) } } # if requested, add a sub-title if (!is.null(sub)) { grob.list <- add.title( gList = grob.list, x = sub, pos = sub.pos, fontface = sub.fontface, fontfamily = sub.fontfamily, col = sub.col, cex = sub.cex ); } # if requested, add a main-title if (!is.null(main)) { grob.list <- add.title( gList = grob.list, x = main, pos = main.pos, fontface = main.fontface, fontfamily = main.fontfamily, col = main.col, cex = main.cex ); } # if a filename is given, write a desired image type, TIFF default if (!is.null(filename)) { # set the graphics driver current.type <- getOption('bitmapType'); if (length(grep('Darwin', Sys.info()['sysname']))) { options(bitmapType = 'quartz'); } else { options(bitmapType = 'cairo'); } # TIFF image type specified if('tiff' == imagetype) { tiff( filename = filename, height = height, width = width, units = units, res = resolution, compression = compression ); } # PNG image type specified else if('png' == imagetype) { png( filename = filename, height = height, width = width, units = units, res = resolution ); } # SVG image type specified else if('svg' == imagetype) { svg( filename = filename, height = height, width = width ); } # Invalid imagetype specified else { flog.error('You have misspelled your "imagetype", please try again',name='VennDiagramLogger') stop('You have misspelled your "imagetype", please try again'); } grid.draw(grob.list); dev.off(); options(bitmapType = current.type); # return a success code return(1); } # if file creation was not requested return the plotting object return(grob.list); } calculate.overlap <- function(x) { # draw a single-set Venn diagram if (1 == length(x)) { overlap <- x; } # draw a pairwise Venn diagram else if (2 == length(x)) { overlap <- list( a1 = x[[1]], a2 = x[[2]], a3 = intersect(x[[1]],x[[2]]) ); } # draw a three-set Venn diagram else if (3 == length(x)) { A <- x[[1]]; B <- x[[2]]; C <- x[[3]]; nab <- intersect(A, B); nbc <- intersect(B, C); nac <- intersect(A, C); nabc <- intersect(nab, C); # calculate overlaps a5 = nabc; a2 = nab[which(!nab %in% a5)]; a4 = nac[which(!nac %in% a5)]; a6 = nbc[which(!nbc %in% a5)]; a1 = A[which(!A %in% c(a2,a4,a5))]; a3 = B[which(!B %in% c(a2,a5,a6))]; a7 = C[which(!C %in% c(a4,a5,a6))]; overlap <- list( a5 = a5, a2 = a2, a4 = a4, a6 = a6, a1 = a1, a3 = a3, a7 = a7 ); } # draw a four-set Venn diagram else if (4 == length(x)) { A <- x[[1]]; B <- x[[2]]; C <- x[[3]]; D <- x[[4]]; n12 <- intersect(A, B); n13 <- intersect(A, C); n14 <- intersect(A, D); n23 <- intersect(B, C); n24 <- intersect(B, D); n34 <- intersect(C, D); n123 <- intersect(n12, C); n124 <- intersect(n12, D); n134 <- intersect(n13, D); n234 <- intersect(n23, D); n1234 <- intersect(n123, D); # calculate overlaps a6 = n1234; a12 = n123[which(!n123 %in% a6)]; a11 = n124[which(!n124 %in% a6)]; a5 = n134[which(!n134 %in% a6)]; a7 = n234[which(!n234 %in% a6)]; a15 = n12[which(!n12 %in% c(a6,a11,a12))]; a4 = n13[which(!n13 %in% c(a6,a5,a12))]; a10 = n14[which(!n14 %in% c(a6,a5,a11))]; a13 = n23[which(!n23 %in% c(a6,a7,a12))]; a8 = n24[which(!n24 %in% c(a6,a7,a11))]; a2 = n34[which(!n34 %in% c(a6,a5,a7))]; a9 = A[which(!A %in% c(a4,a5,a6,a10,a11,a12,a15))]; a14 = B[which(!B %in% c(a6,a7,a8,a11,a12,a13,a15))]; a1 = C[which(!C %in% c(a2,a4,a5,a6,a7,a12,a13))]; a3 = D[which(!D %in% c(a2,a5,a6,a7,a8,a10,a11))]; overlap <- list( a6 = a6, a12 = a12, a11 = a11, a5 = a5, a7 = a7, a15 = a15, a4 = a4, a10 = a10, a13 = a13, a8 = a8, a2 = a2, a9 = a9, a14 = a14, a1 = a1, a3 = a3 ); } # draw a five-set Venn diagram else if (5 == length(x)) { A <- x[[1]]; B <- x[[2]]; C <- x[[3]]; D <- x[[4]]; E <- x[[5]]; n12 <- intersect(A, B); n13 <- intersect(A, C); n14 <- intersect(A, D); n15 <- intersect(A, E); n23 <- intersect(B, C); n24 <- intersect(B, D); n25 <- intersect(B, E); n34 <- intersect(C, D); n35 <- intersect(C, E); n45 <- intersect(D, E); n123 <- intersect(n12, C); n124 <- intersect(n12, D); n125 <- intersect(n12, E); n134 <- intersect(n13, D); n135 <- intersect(n13, E); n145 <- intersect(n14, E); n234 <- intersect(n23, D); n235 <- intersect(n23, E); n245 <- intersect(n24, E); n345 <- intersect(n34, E); n1234 <- intersect(n123, D); n1235 <- intersect(n123, E); n1245 <- intersect(n124, E); n1345 <- intersect(n134, E); n2345 <- intersect(n234, E); n12345 <- intersect(n1234, E); # calculate overlaps a31 = n12345; a30 = n1234[which(!n1234 %in% a31)]; a29 = n1235[which(!n1235 %in% a31)]; a28 = n1245[which(!n1245 %in% a31)]; a27 = n1345[which(!n1345 %in% a31)]; a26 = n2345[which(!n2345 %in% a31)]; a25 = n245[which(!n245 %in% c(a26,a28,a31))]; a24 = n234[which(!n234 %in% c(a26,a30,a31))]; a23 = n134[which(!n134 %in% c(a27,a30,a31))]; a22 = n123[which(!n123 %in% c(a29,a30,a31))]; a21 = n235[which(!n235 %in% c(a26,a29,a31))]; a20 = n125[which(!n125 %in% c(a28,a29,a31))]; a19 = n124[which(!n124 %in% c(a28,a30,a31))]; a18 = n145[which(!n145 %in% c(a27,a28,a31))]; a17 = n135[which(!n135 %in% c(a27,a29,a31))]; a16 = n345[which(!n345 %in% c(a26,a27,a31))]; a15 = n45[which(!n45 %in% c(a18,a25,a16,a28,a27,a26,a31))]; a14 = n24[which(!n24 %in% c(a19,a24,a25,a30,a28,a26,a31))]; a13 = n34[which(!n34 %in% c(a16,a23,a24,a26,a27,a30,a31))]; a12 = n13[which(!n13 %in% c(a17,a22,a23,a27,a29,a30,a31))]; a11 = n23[which(!n23 %in% c(a21,a22,a24,a26,a29,a30,a31))]; a10 = n25[which(!n25 %in% c(a20,a21,a25,a26,a28,a29,a31))]; a9 = n12[which(!n12 %in% c(a19,a20,a22,a28,a29,a30,a31))]; a8 = n14[which(!n14 %in% c(a18,a19,a23,a27,a28,a30,a31))]; a7 = n15[which(!n15 %in% c(a17,a18,a20,a27,a28,a29,a31))]; a6 = n35[which(!n35 %in% c(a16,a17,a21,a26,a27,a29,a31))]; a5 = E[which(!E %in% c(a6,a7,a15,a16,a17,a18,a25,a26,a27,a28,a31,a20,a29,a21,a10))]; a4 = D[which(!D %in% c(a13,a14,a15,a16,a23,a24,a25,a26,a27,a28,a31,a18,a19,a8,a30))]; a3 = C[which(!C %in% c(a21,a11,a12,a13,a29,a22,a23,a24,a30,a31,a26,a27,a16,a6,a17))]; a2 = B[which(!B %in% c(a9,a10,a19,a20,a21,a11,a28,a29,a31,a22,a30,a26,a25,a24,a14))]; a1 = A[which(!A %in% c(a7,a8,a18,a17,a19,a9,a27,a28,a31,a20,a30,a29,a22,a23,a12))]; overlap <- list( a31 = a31, a30 = a30, a29 = a29, a28 = a28, a27 = a27, a26 = a26, a25 = a25, a24 = a24, a23 = a23, a22 = a22, a21 = a21, a20 = a20, a19 = a19, a18 = a18, a17 = a17, a16 = a16, a15 = a15, a14 = a14, a13 = a13, a12 = a12, a11 = a11, a10 = a10, a9 = a9, a8 = a8, a7 = a7, a6 = a6, a5 = a5, a4 = a4, a3 = a3, a2 = a2, a1 = a1 ); } # this should never happen because of the previous check else { flog.error('Invalid size of input object',name='VennDiagramLogger') stop('Invalid size of input object'); } } VennDiagram/R/rotate.sp.R0000644000176200001440000000514014112260207014703 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### ROTATION WITHOUT NEED OF OTHER ARGUMENTS ###################################################### rotate.sp <- function(area.vector, rotation, reverse, additional.rot = FALSE, additional.o7 = 1:7, additional.o3 = 1:3) { rot.f.7 <- list(1:7,c(3,6,7,2,5,4,1),c(7,4,1,6,5,2,3)); rot.f.3 <- list(1:3,c(2,3,1),c(3,1,2)); rot.r.7 <- list(c(3,2,1,6,5,4,7),c(7,6,3,4,5,2,1),c(1,4,7,2,5,6,3)); rot.r.3 <- list(c(2,1,3),3:1,c(1,3,2)); #Add an additional rotation to the orders but not the areas for cases 011A and 111A #Permutations are associative, so this allows for the chaining of the permutations (think of boxes with pointers above indicating the permutation) if(additional.rot) { if (reverse) { area.rot <- rot.r.7[[rotation]]; order.7 <- additional.o7[rot.r.7[[rotation]]]; order.3 <- additional.o3[rot.r.3[[rotation]]]; } else { area.rot <- rot.f.7[[rotation]]; order.7 <- additional.o7[rot.f.7[[rotation]]]; order.3 <- additional.o3[rot.f.3[[rotation]]]; } return( list( areas = area.vector[area.rot], o7 = order.7, o3 = order.3 ) ); } #If not adding an additional rotation to only the orders but not the areas, then continue as usual if (reverse) { order.7 <- rot.r.7[[rotation]]; order.3 <- rot.r.3[[rotation]]; } else { order.7 <- rot.f.7[[rotation]]; order.3 <- rot.f.3[[rotation]]; } return( list( areas = area.vector[order.7], o7 = order.7, o3 = order.3 ) ); } VennDiagram/R/ell2poly.R0000644000176200001440000000442114112260207014527 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO OBTAIN POLYGON COORDINATES SIMILAR TO A CIRCLE #################################### ell2poly <- function(x, y, a, b, rotation, n.sides) { # draw an n-sided polygon that resembles an ellipse rotation <- rotation * pi / 180; # calculate the angle corresponding to each "section" of the polygon # (there are as many sections as there are sides in the polygon) theta <- 2 * pi / n.sides; angles <- seq(0, 2 * pi, theta); # initialize vectors to hold the x and y coordinates of each vertex of the polygon x.coord <- vector(length = n.sides + 1, mode = 'numeric'); x.coord[1] <- x + a * cos(rotation); y.coord <- vector(length = n.sides + 1, mode = 'numeric'); y.coord[1] <- y + a * sin(rotation); # starting from the initial point, sequentially obtain the coordinates of each vertex of the polygon and store them for (i in 1:n.sides) { x.coord[i + 1] <- x + a * cos(angles[i + 1]) * cos(rotation) - b * sin(angles[i + 1]) * sin(rotation); y.coord[i + 1] <- y + a * cos(angles[i + 1]) * sin(rotation) + b * sin(angles[i + 1]) * cos(rotation); } return( list( x = x.coord, y = y.coord ) ); } VennDiagram/R/find.cat.pos.R0000644000176200001440000000303414112260207015252 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. # function to find the position of category names find.cat.pos <- function(x, y, pos, dist, r = NULL) { if (is.null(r)) { cat.x <- dist * sin(pos * pi / 180) + x; cat.y <- dist * cos(pos * pi / 180) + y; } else { cat.x <- (r + dist) * sin(pos * pi / 180) + x; cat.y <- (r + dist) * cos(pos * pi / 180) + y; } return( list( x = cat.x, y = cat.y ) ); } VennDiagram/R/draw.sp.case.R0000644000176200001440000001134414221171123015256 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW SPECIAL CASES ################################################################ draw.sp.case <- function( area.list, enabled.areas, area.x, area.y, attach.label.to, x.centres, y.centres, a.list, b.list, straight.reverse, reverse = FALSE, category, cat.default.pos = 'outer', lwd = rep(2, 3), lty = rep('solid', 3), col = rep('black', 3), label.col = rep('black', 7), cex = rep(1, 7), fontface = rep('plain', 7), fontfamily = rep('serif', 7), cat.pos = c(-40, 40, 0), cat.dist = c(0.05, 0.05, 0.025), cat.col = rep('black', 3), cat.cex = rep(1, 3), cat.fontface = rep('plain', 3), cat.fontfamily = rep('serif', 3), cat.just = list(c(0.5, 1), c(0.5, 1), c(0.5, 0)), cat.prompts = FALSE, fill = NULL, alpha = rep(0.5, 3), print.mode = 'raw', sigdigs=3, ... ) { grob.list <- gList(); # create the three ellipses for (i in 1:3) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = x.centres[i], y = y.centres[i], a = a.list[i], b = b.list[i], gp = gpar( lty = 0, fill = fill[i], alpha = alpha[i] ) ) ); } # create the three ellipse-borders for (i in 1:3) { grob.list <- gList( grob.list, VennDiagram::ellipse( x = x.centres[i], y = y.centres[i], a = a.list[i], b = b.list[i], gp = gpar( lwd = lwd[i], lty = lty[i], col = col[i], fill = 'transparent' ) ) ); } # add the text labels # make it percents if it is enabled # else give the count number processedLabels <- rep('',length(area.list)); if(print.mode[1] == 'percent'){ processedLabels <- paste(signif(area.list/sum(area.list)*100,digits=sigdigs),'%',sep=''); if(isTRUE(print.mode[2] == 'raw')) { processedLabels <- paste(processedLabels,'\n(',area.list,')',sep=''); } } if(print.mode[1] == 'raw'){ processedLabels <- area.list; if(isTRUE(print.mode[2] == 'percent')) { processedLabels <- paste(processedLabels,'\n(',paste(signif(area.list/sum(area.list)*100,digits=sigdigs),'%)',sep=''),sep=''); } } for (i in 1:7) { if (i %in% enabled.areas) { grob.list <- gList( grob.list, textGrob( label = processedLabels[i], x = area.x[i], y = area.y[i], just = c('centre', 'centre'), gp = gpar( col = label.col[i], cex = cex[i], fontface = fontface[i], fontfamily = fontfamily[i] ) ) ); } } # create category labels for (i in 1:3) { # try to auto-assign category position labels if ('outer' == cat.default.pos) { this.cat.pos <- VennDiagram::find.cat.pos( x = x.centres[i], y = y.centres[i], pos = cat.pos[i], dist = cat.dist[i], r = a.list[i] ); } else if ('text' == cat.default.pos) { this.cat.pos <- VennDiagram::find.cat.pos( x = area.x[attach.label.to[i]], y = area.y[attach.label.to[i]], pos = cat.pos[i], dist = cat.dist[i] ); } else { flog.error('Invalid cat.default.pos setting',name='VennDiagramLogger') stop('Invalid cat.default.pos setting'); } # create the label grob.list <- gList( grob.list, textGrob( label = category[i], x = this.cat.pos$x, y = this.cat.pos$y, just = cat.just[[i]], gp = gpar( col = cat.col[i], cex = cat.cex[i], fontface = cat.fontface[i], fontfamily = cat.fontfamily[i] ) ) ); } # fit Venn diagram to size grob.list <- VennDiagram::adjust.venn(grob.list, ...); if (straight.reverse) { if (reverse) { return(VennDiagram::flip.venn(grob.list, axis = 'v')); } } return(grob.list); } VennDiagram/R/add.title.R0000644000176200001440000000324514152010763014644 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO ADD TEXT TO VENN DIAGRAM ########################################################## add.title <- function( gList, x, pos = c(0.5, 1.05), cex = 1, fontface = 'plain', fontfamily = 'serif', col = 'black', just = c(0.5, 1), ... ) { tmp <- textGrob( label = x, x = pos[1], y = pos[2], just = just, gp = gpar( col = col, cex = cex, fontface = fontface, fontfamily = fontfamily ) ); grob.list <- gList(gList, tmp); return(VennDiagram::adjust.venn(grob.list, ...)) } VennDiagram/R/draw.pairwise.venn.R0000644000176200001440000010760714225104074016527 0ustar liggesusers# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR) # This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL # (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. # OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT # WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION # OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. # By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or # nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. # If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or # credit be given to OICR scientists, as scientifically appropriate. ### FUNCTION TO DRAW VENN DIAGRAM WITH TWO SETS ################################################### draw.pairwise.venn <- function( area1, area2, cross.area, category = rep('', 2), euler.d = TRUE, scaled = TRUE, inverted = FALSE, ext.text = TRUE, ext.percent = rep(0.05, 3), lwd = rep(2, 2), lty = rep('solid', 2), col = rep('black', 2), fill = NULL, alpha = rep(0.5, 2), label.col = rep('black', 3), cex = rep(1, 3), fontface = rep('plain', 3), fontfamily = rep('serif', 3), cat.pos = c(-50, 50), cat.dist = rep(0.025, 2), cat.cex = rep(1, 2), cat.col = rep('black', 2), cat.fontface = rep('plain', 2), cat.fontfamily = rep('serif', 2), cat.just = rep(list(c(0.5, 0.5)), 2), cat.default.pos = 'outer', cat.prompts = FALSE, ext.pos = rep(0, 2), ext.dist = rep(0, 2), ext.line.lty = 'solid', ext.length = rep(0.95, 2), ext.line.lwd = 1, rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, sep.dist = 0.05, offset = 0, cex.prop=NULL, print.mode = 'raw', sigdigs=3, ... ) { # area1 > area2 OR area1 < area2 plots the same Venn diagram. Invert using the 'inverted' argument. # check parameter lengths and plausibility of Venn diagram if (length(category) == 1) { category <- rep(category, 2); } else if (length(category) != 2) { flog.error('Unexpected parameter length for "category"',name='VennDiagramLogger') stop('Unexpected parameter length for "category"'); } if (length(ext.percent) == 1) { ext.percent <- rep(ext.percent, 3); } else if (length(ext.percent) != 3) { flog.error('Unexpected parameter length for "ext.percent"',name='VennDiagramLogger') stop('Unexpected parameter length for "ext.percent"'); } if (length(ext.pos) == 1) { ext.pos <- rep(ext.pos, 2); } else if (length(ext.pos) != 2) { flog.error('Unexpected parameter length for "ext.pos"',name='VennDiagramLogger') stop('Unexpected parameter length for "ext.pos"'); } if (length(ext.dist) == 1) { ext.dist <- rep(ext.dist, 2); } else if (length(ext.dist) != 2) { flog.error('Unexpected parameter length for "ext.dist"',name='VennDiagramLogger') stop('Unexpected parameter length for "ext.dist"'); } if (length(ext.length) == 1) { ext.length <- rep(ext.length, 2); } else if (length(ext.length) != 2) { flog.error('Unexpected parameter length for "ext.length"',name='VennDiagramLogger') stop('Unexpected parameter length for "ext.length"'); } if (length(lwd) == 1) { lwd <- rep(lwd, 2); } else if (length(lwd) != 2) { flog.error('Unexpected parameter length for "lwd"',name='VennDiagramLogger') stop('Unexpected parameter length for "lwd"'); } if (length(lty) == 1) { lty <- rep(lty, 2); } else if (length(lty) != 2) { flog.error('Unexpected parameter length for "lty"',name='VennDiagramLogger') stop('Unexpected parameter length for "lty"'); } if (length(col) == 1) { col <- rep(col, 2); } else if (length(col) != 2) { flog.error('Unexpected parameter length for "col"',name='VennDiagramLogger') stop('Unexpected parameter length for "col"'); } if (length(label.col) == 1) { label.col <- rep(label.col, 3); } else if (length(label.col) != 3) { flog.error('Unexpected parameter length for "label.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "label.col"'); } if (length(cex) == 1) { cex <- rep(cex, 3); } else if (length(cex) != 3) { flog.error('Unexpected parameter length for "cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cex"'); } if (length(fontface) == 1) { fontface <- rep(fontface, 3); } else if (length(fontface) != 3) { flog.error('Unexpected parameter length for "fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontface"'); } if (length(fontfamily) == 1) { fontfamily <- rep(fontfamily, 3); } else if (length(fontfamily) != 3) { flog.error('Unexpected parameter length for "fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "fontfamily"'); } if (length(fill) == 1) { fill <- rep(fill, 2); } else if (length(fill) != 2 & length(fill) != 0) { flog.error('Unexpected parameter length for "fill"',name='VennDiagramLogger') stop('Unexpected parameter length for "fill"'); } if (length(alpha) == 1) { alpha <- rep(alpha, 2); } else if (length(alpha) != 2 & length(alpha) != 0) { flog.error('Unexpected parameter length for "alpha"',name='VennDiagramLogger') stop('Unexpected parameter length for "alpha"'); } if (length(ext.line.lwd) != 1) { flog.error('Unexpected parameter length for "ext.line.lwd"',name='VennDiagramLogger') stop('Unexpected parameter length for "ext.line.lwd"'); } if (length(cat.pos) == 1) { cat.pos <- rep(cat.pos, 2); } else if (length(cat.pos) != 2) { flog.error('Unexpected parameter length for "cat.pos"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.pos"'); } if (length(cat.dist) == 1) { cat.dist <- rep(cat.dist, 2); } else if (length(cat.dist) != 2) { flog.error('Unexpected parameter length for "cat.dist"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.dist"'); } if (length(cat.col) == 1) { cat.col <- rep(cat.col, 2); } else if (length(cat.col) != 2) { flog.error('Unexpected parameter length for "cat.col"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.col"'); } if (length(cat.cex) == 1) { cat.cex <- rep(cat.cex, 2); } else if (length(cat.cex) != 2) { flog.error('Unexpected parameter length for "cat.cex"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.cex"'); } if (length(cat.fontface) == 1) { cat.fontface <- rep(cat.fontface, 2); } else if (length(cat.fontface) != 2) { flog.error('Unexpected parameter length for "cat.fontface"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontface"'); } if (length(cat.fontfamily) == 1) { cat.fontfamily <- rep(cat.fontfamily, 2); } else if (length(cat.fontfamily) != 2) { flog.error('Unexpected parameter length for "cat.fontfamily"',name='VennDiagramLogger') stop('Unexpected parameter length for "cat.fontfamily"'); } if (length(offset) != 1) { flog.error('Unexpected parameter length for "Offset". Try using "rotation.degree" to achieve non-vertical offsets',name='VennDiagramLogger') stop('Unexpected parameter length for "Offset". Try using "rotation.degree" to achieve non-vertical offsets'); } if (!(is.list(cat.just) && length(cat.just) == 2 && length(cat.just[[1]]) == 2 && length(cat.just[[2]]) == 2)) { flog.error('Unexpected parameter format for "cat.just"',name='VennDiagramLogger') stop('Unexpected parameter format for "cat.just"'); } # check uninterpretable parameters if (!euler.d & scaled) { flog.error('Uninterpretable parameter combination\nPlease set both euler.d = FALSE and scaled = FALSE to force Venn diagrams.',name='VennDiagramLogger') stop('Uninterpretable parameter combination\nPlease set both euler.d = FALSE and scaled = FALSE to force Venn diagrams.'); } if (offset > 1 | offset < 0) { flog.error('"Offset" must be between 0 and 1. Try using "rotation.degree = 180" to achieve offsets in the opposite direction.',name='VennDiagramLogger') stop('"Offset" must be between 0 and 1. Try using "rotation.degree = 180" to achieve offsets in the opposite direction.'); } if (cross.area > area1 | cross.area > area2) { flog.error('Impossible: cross section area too large.',name='VennDiagramLogger') stop('Impossible: cross section area too large.'); } cat.pos <- cat.pos + rotation.degree; # check category label defaults if (((cat.default.pos != 'outer') & (cat.default.pos != 'text')) & cat.prompts) { # PHH: removed this check from the if, so that code works with expressions: & isTRUE(category != rep("', 2)) flog.info('No default location recognized. Automatically changing to "outer"',name='VennDiagramLogger'); cat.default.pos <- 'outer'; } if ((cat.default.pos == 'outer') & cat.prompts) { flog.info('Placing category labels at default outer locations. Use "cat.pos" and "cat.dist" to modify location.',name='VennDiagramLogger'); flog.info(paste('Current "cat.pos":', cat.pos[1], 'degrees,', cat.pos[2], 'degrees'),name='VennDiagramLogger'); flog.info(paste('Current "cat.dist":', cat.dist[1], ',', cat.dist[2]),name='VennDiagramLogger'); } if ((cat.default.pos == 'text') & cat.prompts) { flog.info('Placing category labels at default text locations. Use "cat.pos" and "cat.dist" to modify location.',name='VennDiagramLogger'); flog.info(paste('Current "cat.pos":', cat.pos[1], 'degrees,', cat.pos[2], 'degrees'),name='VennDiagramLogger'); flog.info(paste('Current "cat.dist":', cat.dist[1], ',', cat.dist[2]),name='VennDiagramLogger'); } max.circle.size = 0.2; # initialize logical variables to hold special conditions special.coincidental <- FALSE; special.inclusion <- FALSE; special.exclusion <- FALSE; list.switch <- FALSE; # initialize gList to hold all Grobs generated grob.list <- gList(); if (!inverted) { tmp1 <- max(area1, area2); tmp2 <- min(area1, area2); if (tmp1 != area1) { list.switch <- TRUE; } area1 <- tmp1; area2 <- tmp2; r1 <- sqrt(area1 / pi); r2 <- sqrt(area2 / pi); if (r2 == 0) {r2 <- 0.5*r1 } shrink.factor <- max.circle.size / r1; } else { tmp1 <- max(area1, area2); tmp2 <- min(area1, area2); if (tmp1 != area1) { list.switch <- TRUE; } area1 <- tmp1; area2 <- tmp2; r1 <- sqrt(area1 / pi); r2 <- sqrt(area2 / pi); if (r1 == 0) {r1 <- 0.5*r2 } shrink.factor <- max.circle.size / r2; } # reverse the list if the order is backwards OR inverted is called (both just reverts to normal) if (xor(list.switch, inverted)) { category <- rev(category); lwd <- rev(lwd); lty <- rev(lty); col <- rev(col); fill <- rev(fill); alpha <- rev(alpha); label.col <- rev(label.col); cex <- rev(cex); fontface <- rev(fontface); fontfamily <- rev(fontfamily); cat.pos <- rev(cat.pos); cat.dist <- rev(cat.dist); cat.col <- rev(cat.col); cat.cex <- rev(cat.cex); cat.fontface <- rev(cat.fontface); cat.fontfamily <- rev(cat.fontfamily); cat.just <- rev(cat.just); ext.pos <- rev(ext.pos); # ext.dist <- rev(ext.dist); # ext.dist intentionally not swapped ext.length <- rev(ext.length); } # convert radii to Grid dimensions r1 <- r1 * shrink.factor; r2 <- r2 * shrink.factor; # check special conditions if (area1 == area2 & area2 == cross.area) { special.coincidental <- TRUE; } if (cross.area != 0 & (cross.area == area2 | cross.area == area1)) { special.inclusion <- TRUE; } if (0 == cross.area) { special.exclusion <- TRUE; } denom <- area1+area2-cross.area; wrapLab <- function(num){ stri = ''; if(print.mode[1] == 'percent'){ stri <- paste(signif(num*100/denom,digits=sigdigs),'%',sep=''); if(isTRUE(print.mode[2] == 'raw')) { stri <- paste(stri,'\n(',num,')',sep=''); } } if(print.mode[1] == 'raw') { stri <- num; if(isTRUE(print.mode[2] == 'percent')) { stri <- paste(stri,'\n(',paste(signif(num*100/denom,digits=sigdigs),'%)',sep=''),sep=''); } } return(stri); } # flog.info(c(area1,area2,cross.area),name='VennDiagramLogger'); # altCross <- cross.area; # altArea1 <- area1; # altArea2 <- area2; # #Do processing on the areas and the cross.area to turn them into the required numbers for printing # if(print.mode[1] == 'percent') # { # denom <- area1+area2-cross.area; # area1 <- area1*100/denom; # area2 <- area2*100/denom; # cross.area <- cross.area*100/denom; # } # else #print.mode[1] == 'raw' # { # denom <- area1+area2-cross.area; # altArea1 <- area1*100/denom; # altArea2 <- area2*100/denom; # altCross <- cross.area*100/denom; # } # flog.info(c(area1,area2,cross.area),name='VennDiagramLogger'); # plot scaled, generic pairwise Venn diagram with or without external texts # ALL OF THE BELOW SECTIONS HAVE A SIMILAR STRUCTURE TO THIS IF BRACKET # IF YOU ARE TRYING TO FIGURE OUT WHAT A CERTAIN SECTION DOES, REFER TO THE ANALOGOUS SECTION INSIDE THIS IF BRACKET if (scaled & !special.inclusion & !special.exclusion & !special.coincidental) { # calculate centres of circles d <- find.dist(area1, area2, cross.area, inverted = inverted); d <- d * shrink.factor; x.centre.1 <- (1 + r1 - r2 - d) / 2; x.centre.2 <- x.centre.1 + d; # draw both circles and their borders tmp <- VennDiagram::ellipse( x = x.centre.1, y = 0.5, a = ifelse(!inverted, r1, r2), b = ifelse(!inverted, r1, r2), gp = gpar( lty = 0, fill = fill[1], alpha = alpha[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = x.centre.2, y = 0.5, a = ifelse(inverted, r1, r2), b = ifelse(inverted, r1, r2), gp = gpar( lty = 0, fill = fill[2], alpha = alpha[2] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = x.centre.1, y = 0.5, a = ifelse(!inverted, r1, r2), b = ifelse(!inverted, r1, r2), gp = gpar( lwd = lwd[1], lty = lty[1], col = col[1], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = x.centre.2, y = 0.5, a = ifelse(inverted, r1, r2), b = ifelse(inverted, r1, r2), gp = gpar( lwd = lwd[2], lty = lty[2], col = col[2], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); ## rescaling area labels to be proportional to area if(length(cex.prop) > 0){ if(length(cex.prop) != 1){ flog.error('Value passed to cex.prop is not length 1',name='VennDiagramLogger') stop('Value passed to cex.prop is not length 1') } ## figure out what function to use func = cex.prop if (!is(cex.prop, 'function')) { if(cex.prop == 'lin'){ func = function(x) x } else if(cex.prop == 'log10'){ func = log10 } else flog.error(paste0('Unknown value passed to cex.prop: ', cex.prop),name='VennDiagramLogger') stop(paste0('Unknown value passed to cex.prop: ', cex.prop)) } ## rescale areas areas = c(area1 - cross.area, cross.area, area2 - cross.area) maxArea = max(areas) for(i in 1:length(areas)){ cex[i] = cex[i] * func(areas[i]) / func(maxArea) if(cex[i] <= 0) stop(paste0('Error in rescaling of area labels: the label of area ', i, ' is less than or equal to zero')) } } # if labels are to be placed outside circles if (ext.text) { area.1.pos <- x.centre.1 + ifelse(!inverted, -r1 + ( (2 * r1 - (r1 + r2 - d)) / 2), -r2 + ( (2 * r2 - (r2 + r1 - d)) / 2)); area.2.pos <- x.centre.2 + ifelse(!inverted, r2 - ( (2 * r2 - (r1 + r2 - d)) / 2), r1 - ( (2 * r1 - (r2 + r1 - d)) / 2)); # distinct area1 is more than the given percentage (label stays inside circle) if ( (area1 - cross.area) / area1 > ext.percent[1] & (area1 - cross.area) / area2 > ext.percent[1]) { # draw label normally tmp <- textGrob( label = wrapLab(ifelse(!inverted, area1, area2) - cross.area), x = area.1.pos, y = 0.5, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); } # percentage is small enough to move label outside circle else { label.pos <- find.cat.pos(area.1.pos, 0.5, ext.pos[1], ext.dist[1], r1); area.1.xpos <- label.pos$x; area.1.ypos <- label.pos$y # draw label outside tmp <- textGrob( label = wrapLab(ifelse(!inverted, area1, area2) - cross.area), x = area.1.xpos, y = area.1.ypos, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); # draw line from circle to label tmp <- linesGrob( x = c(area.1.pos + ext.length[1] * (area.1.xpos - area.1.pos), area.1.pos), y = c(0.5 + ext.length[1] * (area.1.ypos - 0.5), 0.5), gp = gpar( col = label.col[1], lwd = ext.line.lwd, lty = ext.line.lty ) ); grob.list <- gList(grob.list, tmp); } # distinct area2 is more than the given percentage (label stays inside the circle) if ((area2 - cross.area) / area2 > ext.percent[2] & (area2 - cross.area) / area1 > ext.percent[2]) { # draw label normally tmp <- textGrob( label = wrapLab(ifelse(inverted, area1, area2) - cross.area), x = area.2.pos, y = 0.5, gp = gpar( col = label.col[3], cex = cex[3], fontface = fontface[3], fontfamily = fontfamily[3] ) ); grob.list <- gList(grob.list, tmp); } # percentage is small enough to move label outside circle else { label.pos <- find.cat.pos(area.2.pos, 0.5, ext.pos[2], ext.dist[2], r2); area.2.xpos <- label.pos$x; area.2.ypos <- label.pos$y; # draw label outside tmp <- textGrob( label = wrapLab(ifelse(inverted, area1, area2) - cross.area), x = area.2.xpos, y = area.2.ypos, gp = gpar( col = label.col[3], cex = cex[3], fontface = fontface[3], fontfamily = fontfamily[3] ) ); grob.list <- gList(grob.list, tmp); # draw line from circle to label tmp <- linesGrob( x = c(area.2.pos + ext.length[1] * (area.2.xpos - area.2.pos), area.2.pos), y = c(0.5 + ext.length[1] * (area.2.ypos - 0.5), 0.5), gp = gpar( col = label.col[3], lwd = ext.line.lwd, lty = ext.line.lty ) ); grob.list <- gList(grob.list, tmp); } # if intersect area is more than the given percentage (label stays inside area) if (cross.area / area2 > ext.percent[3] & cross.area / area1 > ext.percent[3]) { # draw label normally tmp <- textGrob( label = wrapLab(cross.area), x = x.centre.1 + (d - ifelse(!inverted, r2, r1)) + (r1 + r2 - d) / 2, y = 0.5, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # percentage is small enough to move label outside area else { cross.area.pos <- x.centre.1 + (d - r2) + (r1 + r2 - d) / 2; cross.pos <- find.cat.pos(cross.area.pos, 0.5, ext.pos[1], ext.dist[1], r1 + r2); cross.area.xpos <- cross.pos$x; cross.area.ypos <- cross.pos$y # draw label outside tmp <- textGrob( label = wrapLab(cross.area), x = cross.area.xpos, y = cross.area.ypos, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); # draw line from area to label tmp <- linesGrob( x = c(cross.area.pos + ext.length[2] * (cross.area.xpos - cross.area.pos), cross.area.pos), y = c(0.5 + ext.length[2] * (cross.area.ypos - 0.5), 0.5), gp = gpar( col = label.col[2], lwd = ext.line.lwd, lty = ext.line.lty ) ); grob.list <- gList(grob.list, tmp); } } # if the labels are not to be extended, draw them in their usual locations else { area.1.pos <- x.centre.1 + ifelse(!inverted, -r1 + ( (2 * r1 - (r1 + r2 - d)) / 2), -r2 + ( (2 * r2 - (r2 + r1 - d)) / 2)); tmp <- textGrob( label = wrapLab(ifelse(!inverted, area1, area2) - cross.area), x = area.1.pos, y = 0.5, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); area.2.pos <- x.centre.2 + ifelse(!inverted, r2 - ( (2 * r2 - (r1 + r2 - d)) / 2), r1 - ( (2 * r1 - (r2 + r1 - d)) / 2)); tmp <- textGrob( label = wrapLab(ifelse(inverted, area1, area2) - cross.area), x = area.2.pos, y = 0.5, gp = gpar( col = label.col[3], cex = cex[3], fontface = fontface[3], fontfamily = fontfamily[3] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = wrapLab(cross.area), x = x.centre.1 + (d - ifelse(!inverted, r2, r1)) + (r1 + r2 - d) / 2, y = 0.5, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # find the location of the category labels if ('outer' == cat.default.pos) { cat.pos.1 <- find.cat.pos(x.centre.1, 0.5, (ifelse(!inverted, cat.pos[1], cat.pos[2]) + ifelse(xor(list.switch, inverted), 180, 0)) %% 360, cat.dist[1], ifelse(!inverted, r1, r2)); cat.pos.2 <- find.cat.pos(x.centre.2, 0.5, (ifelse(!inverted, cat.pos[2], cat.pos[1]) + ifelse(xor(list.switch, inverted), 180, 0)) %% 360, cat.dist[2], ifelse(!inverted, r2, r1)); } else if ('text' == cat.default.pos) { cat.pos.1 <- find.cat.pos(area.1.pos, 0.5, cat.pos[1], cat.dist[1]); cat.pos.2 <- find.cat.pos(area.2.pos, 0.5, cat.pos[2], cat.dist[2]); } else { flog.error('Invalid value for "cat.default.pos", should be either "outer" or "text"',name='VennDiagramLogger') stop('Invalid value for "cat.default.pos", should be either "outer or "text"'); } # draw category labels tmp <- textGrob( label = category[1], x = cat.pos.1$x, y = cat.pos.1$y, just = cat.just[[1]], gp = gpar( col = cat.col[1], cex = cat.cex[1], fontface = cat.fontface[1], fontfamily = cat.fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = category[2], x = cat.pos.2$x, y = cat.pos.2$y, just = cat.just[[2]], gp = gpar( col = cat.col[2], cex = cat.cex[2], fontface = cat.fontface[2], fontfamily = cat.fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # plot scaled Venn diagram when one set is completely included in (but not exactly coincidental with) the other set # with or without external texts if (euler.d & special.inclusion & !special.coincidental) { if (inverted) { tmp1 <- area1; tmp2 <- area2; area1 <- tmp2; area2 <- tmp1; } if (!scaled & !inverted) { r1 <- 0.4; r2 <- 0.2; } if (!scaled & inverted) { r1 <- 0.2; r2 <- 0.4; } # draw circles and their borders tmp <- VennDiagram::ellipse( x = 0.5, y = 0.5, a = r1, b = r1, gp = gpar( lty = 0, fill = fill[1], alpha = alpha[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.5 - offset * (r1 - r2), y = 0.5, a = r2, b = r2, gp = gpar( lty = 0, fill = fill[2], alpha = alpha[2] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.5, y = 0.5, a = r1, b = r1, gp = gpar( lwd = lwd[1], lty = lty[1], col = col[1], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.5 - offset * (r1 - r2), y = 0.5, a = r2, b = r2, gp = gpar( lwd = lwd[2], lty = lty[2], col = col[2], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); # draw area labels in appropriate locations area.2.pos <- 0.5 - offset * (r1 - r2); tmp <- textGrob( label = wrapLab(area2), x = area.2.pos, y = 0.5, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); if (!ext.text | !scaled) { area.1.pos <- (1 + r1 + r2 - offset * (r1 - r2)) / 2; tmp <- textGrob( label = wrapLab(area1 - area2), x = area.1.pos, y = 0.5, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); } if (ext.text & scaled) { # draw labels and lines if text is to be extended from areas if (area2 / area1 > 0.5) { area.1.pos <- (1 + r1 + r2 - offset * (r1 - r2)) / 2; area.pos <- find.cat.pos(area.1.pos, 0.5, ext.pos[1], ext.dist[1], r1); area.1.xpos <- area.pos$x; area.1.ypos <- area.pos$y; tmp <- textGrob( label = wrapLab(area1 - area2), x = area.1.xpos, y = area.1.ypos, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- linesGrob( x = c(area.1.pos + ext.length * (area.1.xpos - area.1.pos), area.1.pos), y = c(0.5 + ext.length * (area.1.ypos - 0.5), 0.5), gp = gpar( col = label.col[1], lwd = ext.line.lwd, lty = ext.line.lty ) ); grob.list <- gList(grob.list, tmp); } else { area.1.pos <- (1 + r1 + r2 - offset * (r1 - r2)) / 2; tmp <- textGrob( label = wrapLab(area1 - area2), x = area.1.pos, y = 0.5, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); } } # find the correct position of categories given default position and areas if (cat.default.pos == 'outer') { cat.pos.1 <- find.cat.pos(0.5, 0.5, cat.pos[1], cat.dist[1], r1); cat.pos.2 <- find.cat.pos(0.5 - offset * (r1 - r2), 0.5, cat.pos[2], cat.dist[2], r2); } else if (cat.default.pos == 'text') { cat.pos.1 <- find.cat.pos(area.1.pos, 0.5, cat.pos[1], cat.dist[1]); cat.pos.2 <- find.cat.pos(area.2.pos, 0.5, cat.pos[2], cat.dist[2]); } else { flog.error('Invalid value for "cat.default.pos", should be either "outer" or "text"',name='VennDiagramLogger') stop('Invalid value for "cat.default.pos", should be either "outer" or "text"'); } # add category labels tmp <- textGrob( label = category[1], x = cat.pos.1$x, y = cat.pos.1$y, just = cat.just[[1]], gp = gpar( col = cat.col[1], cex = cat.cex[1], fontface = cat.fontface[1], fontfamily = cat.fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = category[2], x = cat.pos.2$x, y = cat.pos.2$y, just = cat.just[[2]], gp = gpar( col = cat.col[2], cex = cat.cex[2], fontface = cat.fontface[2], fontfamily = cat.fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # plot scaled Venn diagrams when the two sets are coincidental if (euler.d & special.coincidental) { # draw the one circle and its border tmp <- VennDiagram::ellipse( x = 0.5, y = 0.5, a = max.circle.size, b = max.circle.size, gp = gpar( lty = 0, fill = fill[1], alpha = alpha[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.5, y = 0.5, a = max.circle.size, b = max.circle.size, gp = gpar( lwd = lwd[1], lty = lty[1], col = col[1], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); # draw labels on the same circle area.1.pos <- 0.46; tmp <- textGrob( label = wrapLab(area1), x = area.1.pos, y = 0.5, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); area.2.pos <- 0.54; tmp <- textGrob( label = wrapLab(area2), x = area.2.pos, y = 0.5, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = '(Coincidental)', x = 0.5, y = 0.45, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); if (cat.default.pos == 'outer') { cat.pos.1 <- find.cat.pos(0.5, 0.5, cat.pos[1], cat.dist[1], max.circle.size); cat.pos.2 <- find.cat.pos(0.5, 0.5, cat.pos[2], cat.dist[2], max.circle.size); } else if (cat.default.pos == 'text') { cat.pos.1 <- find.cat.pos(area.1.pos, 0.5, cat.pos[1], cat.dist[1]); cat.pos.2 <- find.cat.pos(area.2.pos, 0.5, cat.pos[2], cat.dist[2]); } else { flog.error('Invalid value for "cat.default.pos", should be either "outer" or "text"',name='VennDiagramLogger') stop('Invalid value for "cat.default.pos", should be either "outer" or "text"'); } tmp <- textGrob( label = category[1], x = cat.pos.1$x, y = cat.pos.1$y, just = cat.just[[1]], gp = gpar( col = cat.col[1], cex = cat.cex[1], fontface = cat.fontface[1], fontfamily = cat.fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = category[2], x = cat.pos.2$x, y = cat.pos.2$y, just = cat.just[[2]], gp = gpar( col = cat.col[2], cex = cat.cex[2], fontface = cat.fontface[2], fontfamily = cat.fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # plot scaled Venn diagrams when the two sets are mutually exclusive if (euler.d & special.exclusion) { if (!scaled) { r1 <- 0.2; r2 <- 0.2; } # determine centres of exclusive circles and draw them x.centre.1 <- (1 - 2 * (r1 + r2)) / 2 + r1 - sep.dist / 2; tmp <- VennDiagram::ellipse( x = x.centre.1, y = 0.5, a = r1, b = r1, gp = gpar( lty = 0, fill = fill[1], alpha = alpha[1] ) ); grob.list <- gList(grob.list, tmp); x.centre.2 <- 1 - (1 - 2 * (r1 + r2)) / 2 - r2 + sep.dist / 2; tmp <- VennDiagram::ellipse( x = x.centre.2, y = 0.5, a = r2, b = r2, gp = gpar( lty = 0, fill = fill[2], alpha = alpha[2] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = x.centre.1, y = 0.5, a = r1, b = r1, gp = gpar( lwd = lwd[1], lty = lty[1], col = col[1], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = x.centre.2, y = 0.5, a = r2, b = r2, gp = gpar( lwd = lwd[2], lty = lty[2], col = col[2], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); # draw area and category labels area.1.pos <- x.centre.1; tmp <- textGrob( label = wrapLab(area1), x = area.1.pos, y = 0.5, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); area.2.pos <- x.centre.2; tmp <- textGrob( label = wrapLab(area2), x = area.2.pos, y = 0.5, gp = gpar( col = label.col[3], cex = cex[3], fontface = fontface[3], fontfamily = fontfamily[3] ) ); grob.list <- gList(grob.list, tmp); if (cat.default.pos == 'outer') { cat.pos.1 <- find.cat.pos(x.centre.1, 0.5, cat.pos[1], cat.dist[1], r1); cat.pos.2 <- find.cat.pos(x.centre.2, 0.5, cat.pos[2], cat.dist[2], r2); } else if (cat.default.pos == 'text') { cat.pos.1 <- find.cat.pos(area.1.pos, 0.5, cat.pos[1], cat.dist[1]); cat.pos.2 <- find.cat.pos(area.2.pos, 0.5, cat.pos[2], cat.dist[2]); } else { flog.error('Invalid value for "cat.default.pos", should be either "outer" or "text"',name='VennDiagramLogger') stop('Invalid value for "cat.default.pos", should be either "outer" or "text"'); } tmp <- textGrob( label = category[1], x = cat.pos.1$x, y = cat.pos.1$y, just = cat.just[[1]], gp = gpar( col = cat.col[1], cex = cat.cex[1], fontface = cat.fontface[1], fontfamily = cat.fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = category[2], x = cat.pos.2$x, y = cat.pos.2$y, just = cat.just[[2]], gp = gpar( col = cat.col[2], cex = cat.cex[2], fontface = cat.fontface[2], fontfamily = cat.fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # plot non-scaled Venn diagram if ((!scaled & !euler.d) | (!scaled & euler.d & !special.inclusion & !special.exclusion & !special.coincidental)) { tmp <- VennDiagram::ellipse( x = 0.4, y = 0.5, a = max.circle.size, b = max.circle.size, gp = gpar( lty = 0, fill = fill[1], alpha = alpha[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.6, y = 0.5, a = max.circle.size, b = max.circle.size, gp = gpar( lty = 0, fill = fill[2], alpha = alpha[2] ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.4, y = 0.5, a = max.circle.size, b = max.circle.size, gp = gpar( lwd = lwd[1], lty = lty[1], col = col[1], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); tmp <- VennDiagram::ellipse( x = 0.6, y = 0.5, a = max.circle.size, b = max.circle.size, gp = gpar( lwd = lwd[2], lty = lty[2], col = col[2], fill = 'transparent' ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = wrapLab(area1 - cross.area), x = 0.3, y = 0.5, gp = gpar( col = label.col[1], cex = cex[1], fontface = fontface[1], fontfamily = fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = wrapLab(area2 - cross.area), x = 0.7, y = 0.5, gp = gpar( col = label.col[3], cex = cex[3], fontface = fontface[3], fontfamily = fontfamily[3] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = wrapLab(cross.area), x = 0.5, y = 0.5, gp = gpar( col = label.col[2], cex = cex[2], fontface = fontface[2], fontfamily = fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); if (cat.default.pos == 'outer') { cat.pos.1 <- find.cat.pos(0.4, 0.5, cat.pos[1], cat.dist[1], max.circle.size); cat.pos.2 <- find.cat.pos(0.6, 0.5, cat.pos[2], cat.dist[2], max.circle.size); } else if (cat.default.pos == 'text') { cat.pos.1 <- find.cat.pos(0.3, 0.5, cat.pos[1], cat.dist[1]); cat.pos.2 <- find.cat.pos(0.7, 0.5, cat.pos[2], cat.dist[2]); } else { flog.error('Invalid value for "cat.default.pos", should be either "outer" or "text"',name='VennDiagramLogger') stop('Invalid value for "cat.default.pos", should be either "outer" or "text"'); } tmp <- textGrob( label = category[1], x = cat.pos.1$x, y = cat.pos.1$y, just = cat.just[[1]], gp = gpar( col = cat.col[1], cex = cat.cex[1], fontface = cat.fontface[1], fontfamily = cat.fontfamily[1] ) ); grob.list <- gList(grob.list, tmp); tmp <- textGrob( label = category[2], x = cat.pos.2$x, y = cat.pos.2$y, just = cat.just[[2]], gp = gpar( col = cat.col[2], cex = cat.cex[2], fontface = cat.fontface[2], fontfamily = cat.fontfamily[2] ) ); grob.list <- gList(grob.list, tmp); } # rorate Venn if necessary and add other adjustments to plot grob.list <- adjust.venn(rotate.venn.degrees(grob.list, rotation.degree, rotation.centre[1], rotation.centre[2]), ...); # draw the plot before returning the grob if specified if (ind) { grid.draw(grob.list); } return(grob.list); } VennDiagram/R/make.truth.table.R0000755000176200001440000000073414221171123016142 0ustar liggesusersmake.truth.table <- function(x) { #Fix missing or duplicated names if(is.null(names(x)) || any(c(NA,'') %in% names(x)) || (length(unique(names(x))) != length(names(x)))) { warning('fixing missing, empty or duplicated names.') nx <- if(is.null(names(x))) seq_along(x) else names(x) names(x) <- make.names(nx, unique = TRUE) } tf <- lapply(seq_along(x), function(.) c(TRUE, FALSE)) setNames(do.call(expand.grid, tf), names(x)) } VennDiagram/MD50000644000176200001440000000651614225406014012763 0ustar liggesusers3056588d862f9a28ef0eacf6176f5bfc *DESCRIPTION b44d4fb8b3ad1531c835e37ba47ad45f *NAMESPACE 903646c33b72ae86494b4b11bff1f35c *NEWS 7d07e26bc6d9226b7763d02c00f28d4f *R/add.title.R f023207e1e2c0fa75dccaa14ba91141d *R/adjust.venn.R 0546a7f1fa679ca2b4abbe05ae85409f *R/decide.special.case.R 53c61c3592d7bb117ac071c8872b9fc3 *R/draw.pairwise.venn.R 924f4077ac3782fab86e6065b495064a *R/draw.quad.venn.R ca84e6817a33306675585da18036aad9 *R/draw.quintuple.venn.R c073c8638b13f4ba97d6a352d63daa42 *R/draw.single.venn.R a55c3dfa4acd2ee7b9deb6733e071577 *R/draw.sp.case.R 00ce964042c4378af4d265e658ac092d *R/draw.sp.case.preprocess.R e7b467f71e987023940b5b5a912d131e *R/draw.sp.case.scaled.R f1de9a2b63f8cc68072b4e0fb26df0b9 *R/draw.triple.venn.R ae33f56b7e54cab0d7a3d778fcae010d *R/ell2poly.R 00a3d4c20afe15b0130d0972c8a6c38e *R/ellipse.R 1a3439481bea6b8a23f0c4fe83a3bca4 *R/find.cat.pos.R c33220de66d1797b0ecb08e7dcfe0512 *R/find.dist.R 5bdebdba7348d40013077c92e74b4d7d *R/find.intersect.R c76967c78137f17533968f198f54da01 *R/flip.venn.R 9a6bf1e051941ae148562d8cb0a07248 *R/get.venn.partitions.R 60cdebd007dbc87aae24a09d2de61c44 *R/hypergeometric.test.R f0f3be400daff2b24be7da8c9d430b6b *R/make.truth.table.R dc098d80dbacc74292a1d9829136f529 *R/rotate.R dc85db2cf1cae8d857114194bae75a2e *R/rotate.sp.R f95ef3429ff4605c5e1ea9583ff04451 *R/rotate.venn.degrees.R db083044e8f4ebc653dbf544adffe7ea *R/venn.diagram.R c566b78b4e913495ac8ec76a43c9e967 *TODO d40053b44527933778d4cf635dc31367 *data/plotsFive.rda c598318113da985ae0f52a8bcf24b2d5 *data/plotsFour.rda fc502941bcfa99c3c2dc2aba96d2d884 *data/plotsOne.rda 0ecb1af49c590cb1161bee2917f3894e *data/plotsThree.rda 225e191be8628dba5d516cbea87f54c4 *data/plotsTwo.rda c0f7c97f5090870733c5353833d4847d *man/VennDiagram-internal.Rd c2047305a9dc9cfc4aa82e6b912385c6 *man/VennDiagram-package.Rd a94c3463d8bc11391b32b917b9df575a *man/calculate.overlap.Rd 823e1d3223ac3c5457b59d5e3247c7e7 *man/draw.pairwise.venn.Rd 7d5149319565146c92190e1d59f54c18 *man/draw.quad.venn.Rd b54372c9a640375358d3696a0b4d2505 *man/draw.quintuple.venn.Rd f3aed21415b99bb0865d33871ab9581a *man/draw.single.venn.Rd 59af855918779d495691b3a651fa1c4b *man/draw.sp.case.preprocess.Rd 5067cfb72c050bcb15b4222e5d093c39 *man/draw.sp.case.scaled.Rd 67b1436b15bd65941c066b146bcaae69 *man/draw.triple.venn.Rd 3e97f74a3421b1342ae8352884f2f5cb *man/get.venn.partitions.Rd d5e3fa33681680644f5fd43efde8a304 *man/make.truth.table.Rd e2aaa41af7ade5a21da2d8ebbe80bb6a *man/venn.diagram.Rd 1d67a318b8c15143a35988cf5110333b *man/venn.plot.Rd 38141b5f315bb74dc61a2b79594fa4a6 *tests/test-all.R ac1dd76e521546962aca9cc319787bcd *tests/testthat/Rplots.pdf 0b305bcd7cec09d41dc583b3c921e5f0 *tests/testthat/data/plotsFive.rda b49bb166a13c6b63fcbf74cde1f83342 *tests/testthat/data/plotsFour.rda 1d4cd5b3a2a026560e0a37dd54492b05 *tests/testthat/data/plotsOne.rda c0ba145a8954d22c6d431275c864a0f8 *tests/testthat/data/plotsThree.rda 0223d0ed1257ebe62ed42a4e4362479f *tests/testthat/data/plotsTwo.rda 1ec09162f4181130a086bd5588566d47 *tests/testthat/test-Five.R cbe3d888d89e0b39caec8a3c9dd29290 *tests/testthat/test-Four.R 482d34a41a90f3e42fbde02fe06f17b6 *tests/testthat/test-Log.R e1f2367aba2a1853ca71aeab4568e369 *tests/testthat/test-One.R 82985d2d9cf76b1511de1e964ca47d80 *tests/testthat/test-Three.R b03c81a1b6e41083165fbf6fc499a86b *tests/testthat/test-Two.R e1f5255d62ccd396570834581d08b2c1 *tests/testthat/testFunction.R