[R-gregmisc-users] SF.net SVN: r-gregmisc:[1440] trunk/gplots
Brought to you by:
warnes
Menu
▾
▴
[R-gregmisc-users] SF.net SVN: r-gregmisc:[1440] trunk/gplots
|
From: <wa...@us...> - 2010-06-11 03:11:22
|
Revision: 1440
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1440&view=rev
Author: warnes
Date: 2010-06-11 03:11:16 +0000 (Fri, 11 Jun 2010)
Log Message:
-----------
- venn() now returns an object of class venn() and a plot method for
this class is provided.
- Manual page for venn has been improved, based on contributions by
Steffen Moeller
Modified Paths:
--------------
trunk/gplots/R/venn.R
trunk/gplots/man/venn.Rd
Added Paths:
-----------
trunk/gplots/R/plot.venn.R
Copied: trunk/gplots/R/plot.venn.R (from rev 1431, trunk/gplots/R/venn.R)
===================================================================
--- trunk/gplots/R/plot.venn.R (rev 0)
+++ trunk/gplots/R/plot.venn.R 2010-06-11 03:11:16 UTC (rev 1440)
@@ -0,0 +1,284 @@
+
+plot.venn <- function(x, y, ...,
+ small=0.7,
+ showSetLogicLabel=FALSE,
+ simplify=FALSE
+ )
+ {
+ drawVennDiagram(
+ data=x,
+ small=small,
+ showSetLogicLabel=showSetLogicLabel,
+ simplify=simplify
+ )
+ }
+
+## data should be a matrix.
+## - The first column of the matrix is the
+## count of the number of objects with the specified pattern.
+## - The second and subsequent columns contain 0-1 indicators
+## giving the pattern of group membership
+
+
+drawVennDiagram <-function(data,small=0.7,
+ showSetLogicLabel=FALSE,simplify=FALSE) {
+ numCircles<-NA
+ data.colnames<-NULL
+ data.rownames<-NULL
+ if(is.matrix(data)) {
+ numCircles<-ncol(data)-1
+ data.colnames<-colnames(data)[2:(ncol(data))]
+ # Order is reverted since later indexing starts with
+ # the "lowest bit" and that is expected at the left
+ data.rownames<-rownames(data)
+ }
+ else {
+ cat("Testing only, presuming first argument to specify",
+ "the number of circles to draw.\n")
+ numCircles<-data
+ }
+
+ m<-(0:(-1+2^numCircles))
+
+ if (! is.matrix(data)) {
+ ##cat("prepare randomised data\n")
+ data<-t(sapply(X=m,FUN=function(v){
+ l<-baseOf(v,2,numCircles)
+ #print(l)
+ return(l)
+ }))
+
+ #print(data)
+
+ #data.names<-apply(data,1,function(X){
+ # return(paste(X),collapse="")
+ #})
+ for(i in m) {
+ n<-paste(data[i+1,],collapse="")
+ if (is.null(data.rownames)) {
+ data.rownames<-n
+ }
+ else {
+ data.rownames<-c(data.rownames,n)
+ }
+ }
+ #print(data.rownames)
+ data<-cbind(sample(1:100,size=2^numCircles,replace=TRUE),data)
+ #print(data)
+ rownames(data)<-data.rownames
+ data.colnames<-LETTERS[1:numCircles]
+ colnames(data)<-c("num",data.colnames)
+ }
+
+ if ((2 <= numCircles && numCircles <= 3) || (4 == numCircles && simplify)) {
+ ##cat("drawing circles\n")
+ # draw circles with radius 1.7 equally distributed
+ # with centers on a circle of radius 1
+
+ degrees<-2*pi/numCircles*(1:numCircles)
+
+ # scaling factor
+ s<-1/8
+
+ x<-sapply(degrees,FUN=sin)*s + 0.5
+ y<-sapply(degrees,FUN=cos)*s + 0.5
+
+
+ if(!require(grid)) {
+ stop("Need access to 'grid' library.")
+ }
+ grid.newpage()
+ grid.circle(x,y,3/12,name="some name")
+
+ ##cat("filling data\n")
+
+ distFromZero<-rep(NA,2^numCircles)
+ degrees<-rep(NA,2^numCircles)
+
+ degrees[(2^numCircles)]<-0
+ distFromZero[(2^numCircles)]<-0
+
+ for (i in 0:(numCircles-1)) {
+ distFromZero[2^i+1] <- 4/12
+ degrees[2^i+1] <- 2*pi/numCircles*i
+ d<-degrees[2^i+1]
+
+ #print(data.colnames)
+
+ grid.text(
+ # starting from the lowest bit, hence reading
+ # lables from the right
+ label=data.colnames[numCircles - i],
+ x=sin(d)*5/12+0.5,
+ y=cos(d)*5/12+0.5,
+ rot=0
+ )
+
+ }
+
+ if (4==numCircles) {
+ for (i in 0:(numCircles-1)) {
+ # Current set bit plus the bit left of it and the bit right of it
+ distFromZero[2^i
+ +2^((i+numCircles-1)%%numCircles)
+ +2^((i+1)%%numCircles)+1] <- 2/12
+ degrees[2^i
+ +2^((i+numCircles-1)%%numCircles)
+ +2^((i+1)%%numCircles)+1] <- degrees[2^i+1]
+ }
+ }
+
+ #degrees[2^i+1] + degrees[2^((i+1)%%numCircles)+1])/2
+
+ if (3 <=numCircles) {
+ for (i in 0:(numCircles-1)) {
+ distFromZero[(2^i+2^((i+1)%%numCircles))+1]<- 3/12
+ if (i == (numCircles-1)) {
+ degrees[(2^i+2^((i+1)%%numCircles))+1] <- (
+ degrees[2^i+1] + 2*pi+ degrees[1+1])/2
+ }
+ else {
+ degrees[(2^i+2^((i+1)%%numCircles))+1] <- (
+ degrees[2^i+1] + degrees[2^((i+1)%%numCircles)+1])/2
+ }
+
+ }
+ }
+
+ for(i in 1:2^numCircles) {
+ n<-paste(baseOf((i-1),2,numCircles),collapse="")
+ v<-data[n,1]
+ d<-degrees[i]
+ if (1 == length(d) && is.na(d)) {
+ if (v>0) warning("Not shown: ",n,"is",v,"\n")
+ }
+ else {
+ l<-distFromZero[i]
+ x<-sin(d)*l+0.5
+ y<-cos(d)*l+0.5
+ #cat("i=",i," x=",x," y=",y," label=",n,"\n")
+ l<-v
+ if (showSetLogicLabel) l<-paste(n,"\n",v,sep="")
+ grid.text(label=l,x=x,y=y,rot=0)
+ }
+ }
+ }
+ else if (4 <= numCircles && numCircles <= 5 && !simplify) {
+
+ grid.newpage()
+ # Function to turn and move ellipses
+ relocate_elp <- function(e, alpha, x, y){
+ phi=(alpha/180)*pi;
+ xr=e[,1]*cos(phi)+e[,2]*sin(phi)
+ yr=-e[,1]*sin(phi)+e[,2]*cos(phi)
+ xr=x+xr;
+ yr=y+yr;
+ return(cbind(xr, yr))
+ }
+
+ lab<-function (identifier, data, showLabel=showSetLogicLabel) {
+ r<-data[identifier,1]
+ if (showLabel) {
+ return(paste(identifier,r,sep="\n"))
+ }
+ else {
+ return(r)
+ }
+ }
+
+ plot(c(0, 400), c(0, 400), type="n", axes=F, ylab="", xlab="")
+ if (4 == numCircles) {
+ elps=cbind(162*cos(seq(0,2*pi,len=1000)), 108*sin(seq(0,2*pi,len=1000)));
+
+ plot(c(0, 400), c(0, 400), type="n", axes=F, ylab="", xlab="");
+ polygon(relocate_elp(elps, 45,130, 170));
+ polygon(relocate_elp(elps, 45,200, 200));
+ polygon(relocate_elp(elps, 135,200, 200));
+ polygon(relocate_elp(elps, 135,270, 170));
+
+ text( 35, 315, data.colnames[1],cex=1.5)
+ text(138, 347, data.colnames[2],cex=1.5)
+ text(262, 347, data.colnames[3],cex=1.5)
+ text(365, 315, data.colnames[4],cex=1.5)
+
+ elps <- cbind(130*cos(seq(0,2*pi,len=1000)),
+ 80*sin(seq(0,2*pi,len=1000)))
+
+ text( 35, 250, lab("1000",data));
+ text(140, 315, lab("0100",data));
+ text(260, 315, lab("0010",data));
+ text(365, 250, lab("0001",data));
+
+ text( 90, 280, lab("1100",data), cex=small)
+ text( 95, 110, lab("1010",data) )
+ text(200, 50, lab("1001",data), cex=small)
+ text(200, 290, lab("0110",data))
+ text(300, 110, lab("0101",data))
+ text(310, 280, lab("0011",data), cex=small)
+
+ text(130, 230, lab("1110",data))
+ text(245, 75, lab("1101",data),cex=small)
+ text(155, 75, lab("1011",data),cex=small)
+ text(270, 230, lab("0111",data))
+
+ text(200,150,lab("1111",data))
+ }
+ else if (5 == numCircles) {
+
+ elps <- cbind(150*cos(seq(0,2*pi,len=1000)),
+ 60*sin(seq(0,2*pi,len=1000)))
+
+ polygon(relocate_elp(elps, 90,200, 250))
+ polygon(relocate_elp(elps, 162,250, 220))
+ polygon(relocate_elp(elps, 234,250, 150))
+ polygon(relocate_elp(elps, 306,180, 125))
+ polygon(relocate_elp(elps, 378,145, 200))
+
+ text( 50, 280, data.colnames[1],cex=1.5)
+ text(150, 400, data.colnames[2],cex=1.5)
+ text(350, 300, data.colnames[3],cex=1.5)
+ text(350, 20, data.colnames[4],cex=1.5)
+ text( 50, 10, data.colnames[5],cex=1.5)
+
+ text( 61, 228, lab("10000",data));
+ text(194, 329, lab("01000",data));
+ text(321, 245, lab("00100",data));
+ text(290, 81, lab("00010",data));
+ text(132, 69, lab("00001",data));
+
+ text(146, 250, lab("11000",data), cex=small)
+ text(123, 188, lab("10100",data), cex=small)
+ text(275, 152, lab("10010",data), cex=small)
+ text(137, 146, lab("10001",data), cex=small)
+ text(243, 268, lab("01100",data), cex=small)
+ text(175, 267, lab("01010",data), cex=small)
+ text(187, 117, lab("01001",data), cex=small)
+ text(286, 188, lab("00110",data), cex=small)
+ text(267, 235, lab("00101",data), cex=small)
+ text(228, 105, lab("00011",data), cex=small)
+
+ text(148, 210, lab("11100",data),cex=small)
+ text(159, 253, lab("11010",data),cex=small)
+ text(171, 141, lab("11001",data),cex=small)
+ text(281, 175, lab("10110",data),cex=small)
+ text(143, 163, lab("10101",data),cex=small)
+ text(252, 145, lab("10011",data),cex=small)
+ text(205, 255, lab("01110",data),cex=small)
+ text(254, 243, lab("01101",data),cex=small)
+ text(211, 118, lab("01011",data),cex=small)
+ text(267, 211, lab("00111",data),cex=small)
+
+ text(170, 231,lab("11110",data),cex=small)
+ text(158, 169,lab("11101",data),cex=small)
+ text(212, 139,lab("11011",data),cex=small)
+ text(263, 180,lab("10111",data),cex=small)
+ text(239, 232,lab("01111",data),cex=small)
+
+ text(204,190,lab("11111",data))
+ }
+ }
+ else {
+ stop(paste("The printing of ",numCircles," circles is not yet supported."))
+ }
+
+}
Modified: trunk/gplots/R/venn.R
===================================================================
--- trunk/gplots/R/venn.R 2010-05-03 16:26:14 UTC (rev 1439)
+++ trunk/gplots/R/venn.R 2010-06-11 03:11:16 UTC (rev 1440)
@@ -9,30 +9,6 @@
# The sum of values placed is the number of entries of
# each set.
-# transform base
-# v = value of base 10 to be transformed
-# b = new base
-# l = minimal length of returned array (default is 1)
-# return value: array of factors, highest exponent first
-baseOf<-function(v,b,l=1) {
- remainder<-v
- i<-l
- ret<-NULL
- while(remainder>0 || i>0) {
- #print(paste("i=",i," remainder=",remainder))
- m<-remainder%%b
- if (is.null(ret)) {
- ret<-m
- }
- else {
- ret<-c(m,ret)
- }
- remainder <- remainder %/% b
- i<-i-1
- }
- return(ret)
-}
-
# Function to determine values of a venn diagram
# It works for an arbitrary large set of input sets.
#
@@ -82,7 +58,7 @@
else {
sel<-NULL
}
- }
+ }
}
# something should be in sel now, otherwise
@@ -139,284 +115,13 @@
else{
colnames(result.table)<-c("num",names(l))
}
+ class(result.table) <- "venn"
return(result.table)
}
#print(getVennCounts(list(A,B,C,D)))
#print(getVennCounts(list(a=A,b=B,c=C,d=D)))
-
-## data should be a matrix.
-## - The first column of the matrix is the
-## count of the number of objects with the specified pattern.
-## - The second and subsequent columns contain 0-1 indicators
-## giving the pattern of group membership
-
-
-drawVennDiagram <-function(data,small=0.7,
- showSetLogicLabel=FALSE,simplify=FALSE) {
- numCircles<-NA
- data.colnames<-NULL
- data.rownames<-NULL
- if(is.matrix(data)) {
- numCircles<-ncol(data)-1
- data.colnames<-colnames(data)[2:(ncol(data))]
- # Order is reverted since later indexing starts with
- # the "lowest bit" and that is expected at the left
- data.rownames<-rownames(data)
- }
- else {
- cat("Testing only, presuming first argument to specify",
- "the number of circles to draw.\n")
- numCircles<-data
- }
-
- m<-(0:(-1+2^numCircles))
-
- if (! is.matrix(data)) {
- ##cat("prepare randomised data\n")
- data<-t(sapply(X=m,FUN=function(v){
- l<-baseOf(v,2,numCircles)
- #print(l)
- return(l)
- }))
-
- #print(data)
-
- #data.names<-apply(data,1,function(X){
- # return(paste(X),collapse="")
- #})
- for(i in m) {
- n<-paste(data[i+1,],collapse="")
- if (is.null(data.rownames)) {
- data.rownames<-n
- }
- else {
- data.rownames<-c(data.rownames,n)
- }
- }
- #print(data.rownames)
- data<-cbind(sample(1:100,size=2^numCircles,replace=TRUE),data)
- #print(data)
- rownames(data)<-data.rownames
- data.colnames<-LETTERS[1:numCircles]
- colnames(data)<-c("num",data.colnames)
- }
-
- if ((2 <= numCircles && numCircles <= 3) || (4 == numCircles && simplify)) {
- ##cat("drawing circles\n")
- # draw circles with radius 1.7 equally distributed
- # with centers on a circle of radius 1
-
- degrees<-2*pi/numCircles*(1:numCircles)
-
- # scaling factor
- s<-1/8
-
- x<-sapply(degrees,FUN=sin)*s + 0.5
- y<-sapply(degrees,FUN=cos)*s + 0.5
-
-
- if(!require(grid)) {
- stop("Need access to 'grid' library.")
- }
- grid.newpage()
- grid.circle(x,y,3/12,name="some name")
-
- ##cat("filling data\n")
-
- distFromZero<-rep(NA,2^numCircles)
- degrees<-rep(NA,2^numCircles)
-
- degrees[(2^numCircles)]<-0
- distFromZero[(2^numCircles)]<-0
-
- for (i in 0:(numCircles-1)) {
- distFromZero[2^i+1] <- 4/12
- degrees[2^i+1] <- 2*pi/numCircles*i
- d<-degrees[2^i+1]
-
- #print(data.colnames)
-
- grid.text(
- # starting from the lowest bit, hence reading
- # lables from the right
- label=data.colnames[numCircles - i],
- x=sin(d)*5/12+0.5,
- y=cos(d)*5/12+0.5,
- rot=0
- )
-
- }
-
- if (4==numCircles) {
- for (i in 0:(numCircles-1)) {
- # Current set bit plus the bit left of it and the bit right of it
- distFromZero[2^i
- +2^((i+numCircles-1)%%numCircles)
- +2^((i+1)%%numCircles)+1] <- 2/12
- degrees[2^i
- +2^((i+numCircles-1)%%numCircles)
- +2^((i+1)%%numCircles)+1] <- degrees[2^i+1]
- }
- }
-
- #degrees[2^i+1] + degrees[2^((i+1)%%numCircles)+1])/2
-
- if (3 <=numCircles) {
- for (i in 0:(numCircles-1)) {
- distFromZero[(2^i+2^((i+1)%%numCircles))+1]<- 3/12
- if (i == (numCircles-1)) {
- degrees[(2^i+2^((i+1)%%numCircles))+1] <- (
- degrees[2^i+1] + 2*pi+ degrees[1+1])/2
- }
- else {
- degrees[(2^i+2^((i+1)%%numCircles))+1] <- (
- degrees[2^i+1] + degrees[2^((i+1)%%numCircles)+1])/2
- }
-
- }
- }
-
- for(i in 1:2^numCircles) {
- n<-paste(baseOf((i-1),2,numCircles),collapse="")
- v<-data[n,1]
- d<-degrees[i]
- if (1 == length(d) && is.na(d)) {
- if (v>0) warning("Not shown: ",n,"is",v,"\n")
- }
- else {
- l<-distFromZero[i]
- x<-sin(d)*l+0.5
- y<-cos(d)*l+0.5
- #cat("i=",i," x=",x," y=",y," label=",n,"\n")
- l<-v
- if (showSetLogicLabel) l<-paste(n,"\n",v,sep="")
- grid.text(label=l,x=x,y=y,rot=0)
- }
- }
- }
- else if (4 <= numCircles && numCircles <= 5 && !simplify) {
-
- grid.newpage()
- # Function to turn and move ellipses
- relocate_elp <- function(e, alpha, x, y){
- phi=(alpha/180)*pi;
- xr=e[,1]*cos(phi)+e[,2]*sin(phi)
- yr=-e[,1]*sin(phi)+e[,2]*cos(phi)
- xr=x+xr;
- yr=y+yr;
- return(cbind(xr, yr))
- }
-
- lab<-function (identifier, data, showLabel=showSetLogicLabel) {
- r<-data[identifier,1]
- if (showLabel) {
- return(paste(identifier,r,sep="\n"))
- }
- else {
- return(r)
- }
- }
-
- plot(c(0, 400), c(0, 400), type="n", axes=F, ylab="", xlab="")
- if (4 == numCircles) {
- elps=cbind(162*cos(seq(0,2*pi,len=1000)), 108*sin(seq(0,2*pi,len=1000)));
-
- plot(c(0, 400), c(0, 400), type="n", axes=F, ylab="", xlab="");
- polygon(relocate_elp(elps, 45,130, 170));
- polygon(relocate_elp(elps, 45,200, 200));
- polygon(relocate_elp(elps, 135,200, 200));
- polygon(relocate_elp(elps, 135,270, 170));
-
- text( 35, 315, data.colnames[1],cex=1.5)
- text(138, 347, data.colnames[2],cex=1.5)
- text(262, 347, data.colnames[3],cex=1.5)
- text(365, 315, data.colnames[4],cex=1.5)
-
- elps <- cbind(130*cos(seq(0,2*pi,len=1000)),
- 80*sin(seq(0,2*pi,len=1000)))
-
- text( 35, 250, lab("1000",data));
- text(140, 315, lab("0100",data));
- text(260, 315, lab("0010",data));
- text(365, 250, lab("0001",data));
-
- text( 90, 280, lab("1100",data), cex=small)
- text( 95, 110,lab("1010",data) )
- text(200, 50, lab("1001",data), cex=small)
- text(200, 290, lab("0110",data))
- text(300, 110, lab("0101",data))
- text(310, 280, lab("0011",data), cex=small)
-
- text(130, 230, lab("1110",data))
- text(245, 75, lab("1101",data),cex=small)
- text(155, 75, lab("1011",data),cex=small)
- text(270, 230, lab("0111",data))
-
- text(200,150,lab("1111",data))
- }
- else if (5 == numCircles) {
-
- elps <- cbind(150*cos(seq(0,2*pi,len=1000)),
- 60*sin(seq(0,2*pi,len=1000)))
-
- polygon(relocate_elp(elps, 90,200, 250))
- polygon(relocate_elp(elps, 162,250, 220))
- polygon(relocate_elp(elps, 234,250, 150))
- polygon(relocate_elp(elps, 306,180, 125))
- polygon(relocate_elp(elps, 378,145, 200))
-
- text( 50, 280, data.colnames[1],cex=1.5)
- text(150, 400, data.colnames[2],cex=1.5)
- text(350, 300, data.colnames[3],cex=1.5)
- text(350, 20, data.colnames[4],cex=1.5)
- text( 50, 10, data.colnames[5],cex=1.5)
-
- text( 61, 228, lab("10000",data));
- text(194, 329, lab("01000",data));
- text(321, 245, lab("00100",data));
- text(290, 81, lab("00010",data));
- text(132, 69, lab("00001",data));
-
- text(146, 250, lab("11000",data), cex=small)
- text(123, 188, lab("10100",data), cex=small)
- text(275, 152, lab("10010",data), cex=small)
- text(137, 146, lab("10001",data), cex=small)
- text(243, 268, lab("01100",data), cex=small)
- text(175, 267, lab("01010",data), cex=small)
- text(187, 117, lab("01001",data), cex=small)
- text(286, 188, lab("00110",data), cex=small)
- text(267, 235, lab("00101",data), cex=small)
- text(228, 105, lab("00011",data), cex=small)
-
- text(148, 210, lab("11100",data),cex=small)
- text(159, 253, lab("11010",data),cex=small)
- text(171, 141, lab("11001",data),cex=small)
- text(281, 175, lab("10110",data),cex=small)
- text(143, 163, lab("10101",data),cex=small)
- text(252, 145, lab("10011",data),cex=small)
- text(205, 255, lab("01110",data),cex=small)
- text(254, 243, lab("01101",data),cex=small)
- text(211, 118, lab("01011",data),cex=small)
- text(267, 211, lab("00111",data),cex=small)
-
- text(170, 231,lab("11110",data),cex=small)
- text(158, 169,lab("11101",data),cex=small)
- text(212, 139,lab("11011",data),cex=small)
- text(263, 180,lab("10111",data),cex=small)
- text(239, 232,lab("01111",data),cex=small)
-
- text(204,190,lab("11111",data))
- }
- }
- else {
- stop(paste("The printing of ",numCircles," circles is not yet supported."))
- }
-
-}
-
-
venn <- function(data,
universe=NA,
small=0.7,
@@ -424,8 +129,8 @@
simplify=FALSE,
show.plot=TRUE)
{
- counts <- getVennCounts(data)
-
+ counts <- getVennCounts(data, universe=universe)
+
if(show.plot)
drawVennDiagram(data=counts,
small=small,
@@ -433,5 +138,7 @@
simplify=simplify
)
+
invisible(counts)
}
+
Modified: trunk/gplots/man/venn.Rd
===================================================================
--- trunk/gplots/man/venn.Rd 2010-05-03 16:26:14 UTC (rev 1439)
+++ trunk/gplots/man/venn.Rd 2010-06-11 03:11:16 UTC (rev 1440)
@@ -2,74 +2,133 @@
\alias{venn}
\title{Plot a Venn diagram}
\description{
-Plot Venn diagrams for up to 5 sets
+ Plot a Venn diagrams for up to 5 sets
}
\usage{
venn(data, universe=NA, small=0.7, showSetLogicLabel=FALSE,
simplify=FALSE, show.plot=TRUE)
+\method{plot}{venn}(x, y, ..., small=0.7, showSetLogicLabel=FALSE,
+ simplify=FALSE)
}
\arguments{
- \item{data}{data to be plotted (see below)}
- \item{universe}{??}
- \item{small}{Character size of group labels}
+ \item{data}{Either a list list containing vectors of names or indices
+ of group members, or a data frame containing boolean indicators of
+ group membership (see below)}
+ \item{universe}{Subset of valid name/index elements. Values ignore values
+ in code{data} not in this list will be ignored. Use \code{NA} to
+ use all elements of \code{data} (the default).}
+ \item{small}{Character scaling of the smallest group counts}
\item{showSetLogicLabel}{Logical flag indicating whether the internal
group label should be displayed}
- \item{simplify}{Logical flag indicating whether unobserved group
+ \item{simplify}{Logical flag indicating whether unobserved groups
should be omitted.}
\item{show.plot}{Logical flag indicating whether the plot should be
displayed. If false, simply returns the group count matrix.}
}
\details{
\code{data} should be either a named list of vectors containing
- indexes of group members (1, 2, 3,..) , or a data frame containing indicator
- variables (TRUE, FALSE, TRUE, ..) for group membership. Group names
- will be taken from the component vector or column names.
+ character string names ("GeneAABBB", "GeneBBBCY", .., "GeneXXZZ") or
+ indexes of group members (1, 2, .., N), or a data frame containing
+ indicator variables (TRUE, FALSE, TRUE, ..) for group membership.
+ Group names will be taken from the component list element or column
+ names.
}
\value{
- A matrix of all possible sets of groups, and the observed numer of
- items beloinging to each set of groups is returned invisibly.
- The fist column contains observed counts, subsequent columns contain
- 0-1 indicators of group membership.
+ Invisibly returns an object of class "venn", containing a matrix of
+ all possible sets of groups, and the observed count of items belonging
+ to each The fist column contains observed counts, subsequent columns
+ contain 0-1 indicators of group membership.
}
-\author{Steffen Moeller \email{steffen\_mo...@gm...},
+\author{
+ Steffen Moeller \email{steffen\_mo...@gm...},
with cleanup and packaging by Gregory R. Warnes
- \email{gr...@ra...}.}
+ \email{gr...@wa...}.}
\examples{
##
-## Example using a list of item indexes belonging to the
+## Example using a list of item names belonging to the
## specified group.
##
-A<- 1:20
-B<- 1:20
-C<- 2:20
-D<- 3:21
-input<-list(A,B,C,D)
+
+## construct some fake gene names..
+oneName <- function() paste(sample(LETTERS,5,replace=T),collapse="")
+geneNames <- replicate(1000, oneName())
+
+##
+GroupA <- sample(geneNames, 400, replace=FALSE)
+GroupB <- sample(geneNames, 750, replace=FALSE)
+GroupC <- sample(geneNames, 250, replace=FALSE)
+GroupD <- sample(geneNames, 300, replace=FALSE)
+input <-list(GroupA,GroupB,GroupC,GroupD)
input
venn(input)
+
##
-## Example using a data frame of indicator columns
+## Example using a list of item indexes belonging to the
+## specified group.
##
-A<- as.logical(rbinom(100, 1, 0.2))
-B<- as.logical(rbinom(100, 1, 0.7))
-C<- as.logical(rbinom(100, 1, 0.2))
-D<- as.logical(rbinom(100, 1, 0.1))
-input<-data.frame(A,B,C,D)
-venn(input)
+GroupA.i <- which(geneNames %in% GroupA)
+GroupB.i <- which(geneNames %in% GroupB)
+GroupC.i <- which(geneNames %in% GroupC)
+GroupD.i <- which(geneNames %in% GroupD)
+input.i <-list(A=GroupA.i,B=GroupB.i,C=GroupC.i,D=GroupD.i)
+input.i
+venn(input.i)
-## Omit un-observed groupings
-tmp <- venn(input, simplify=TRUE)
+##
+## Example using a data frame of indicator ('f'lag) columns
+##
+GroupA.f <- geneNames %in% GroupA
+GroupB.f <- geneNames %in% GroupB
+GroupC.f <- geneNames %in% GroupC
+GroupD.f <- geneNames %in% GroupD
+input.df <- data.frame(A=GroupA.f,B=GroupB.f,C=GroupC.f,D=GroupD.f)
+head(input.df)
+venn(input.df)
-## show details
+## smaller set to create empty groupings
+small <- input[1:20,]
+
+venn(small, simplify=FALSE) # with empty groupings
+venn(small, simplify=TRUE) # without empty groupings
+
+## Capture group counts, but don't plot
+tmp <- venn(input, show.plot=FALSE)
tmp
## Show internal binary group labels
venn(input, showSetLogicLabel=TRUE)
-## Specify universe
-venn(input, universe=NULL, showSetLogicLabel=TRUE)
+## Limit universe
+tmp <- venn(input, universe=geneNames[1:100])
+tmp
+
+##
+## Example to determine which elements are in A and B but not in
+## C and D: first determine the universe, then form indicator columns
+## and perform intersections on these. R allows using the set operations
+## directly, but some might find this approach more intuitive.
+##
+
+universe <- unique(c(GroupA,GroupB,GroupC,GroupD))
+GroupA.l <-universe %in% GroupA
+GroupB.l <-universe %in% GroupB
+GroupC.l <-universe %in% GroupC
+GroupD.l <-universe %in% GroupD
+
+## Genes that are in GroupA and in GroupB but not in GroupD (unification
+## of sets III0 and II00 in the venn diagram:
+universe[GroupA.l & GroupB.l & !GroupD.l]
+
+##
+## Alternatively: construct a function to test for the pattern you want.
+##
+test <- function(x) (x %in% GroupA) & (x %in% GroupB) & !(x %in% GroupC)
+universe[ test(universe) ]
+
+
}
\keyword{hplot}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
