[Vennerable-commits] r73 - pkg/Vennerable/inst/doc

[noreply at r-forge.r-project.org]

Author: js229
Date: 2009-10-09 00:23:02 +0200 (Fri, 09 Oct 2009)
New Revision: 73

Modified:
   pkg/Vennerable/inst/doc/Euler3Sets.Rnw
Log:


Modified: pkg/Vennerable/inst/doc/Euler3Sets.Rnw
===================================================================
--- pkg/Vennerable/inst/doc/Euler3Sets.Rnw	2009-10-08 22:22:21 UTC (rev 72)
+++ pkg/Vennerable/inst/doc/Euler3Sets.Rnw	2009-10-08 22:23:02 UTC (rev 73)
@@ -45,69 +45,11 @@
 <<>>=
 library(Vennerable)
 library(xtable)
-vs <- expand.grid(A=c(0,1),B=c(0,1),C=c(0,1))
-vs$VS <- apply(data.matrix(vs[,1:3]),1,paste,collapse="")
-vs <- subset(vs,VS!="000")
+Eclass <-EulerClasses(n=3)
+Ehave3 <- subset(Eclass,SetsRepresented==3 , -SetsRepresented)
+Ehave <- subset(Eclass, ESignature==ESignatureCanonical,-ESignatureCanonical)
 
-
-Euler.from.vs <- function(vs) {
-	w <- lapply(vs$VS,function(x){c(0,1)})
-	names(w) <- vs$VS
-	Eulers <- do.call(expand.grid,w)
-	Eulers$VS <- apply(data.matrix(Eulers),1,paste,collapse="")
-	Eulers
-}
-
-
-library(gtools)
-worder <-   permutations(3,3)
-worder <- lapply(1:nrow(worder),function(x){worder[x,]})
-P2 <- lapply(worder,function(x) {
-	wname <- paste("Order",paste(x,collapse=""))
-#	cat(wname,"\n")
-	vs.order <- vs[,x]
-	E2 <- Euler.from.vs(vs)
-	E2 <- E2[do.call(order,E2[,1:7]),]
-	vs.order$VS <- apply(data.matrix(vs.order),1,paste,collapse="")
-	vs.perm <- match(vs.order$VS,vs$VS)
-	E2.perm <- E2[,vs.perm]
-	E2.perm$VS  <- apply(data.matrix(E2.perm),1,paste,collapse="")
-	E2.perm$VS
-	}
-)
-
-
-# now E2 has the indicator strings generated by all possible orderings
-# with the corresponding row names
-E3 <- do.call(rbind,P2)
-F3 <- unique(apply(E3,2,function(x)(unique(sort(x)))))
-iclasses <- (sapply(F3,paste,collapse=";"))
-rclasses <- sapply(F3,function(x)x[1])
-
-irclasses <- data.frame(VS=rclasses,iclasses=iclasses,stringsAsFactors=FALSE)
-E1 <- Euler.from.vs(vs)
-Eclass <- merge(E1,irclasses)
-rownames(Eclass) <- 1:nrow(Eclass)
-Eclass <- Eclass[order(Eclass$VS),]
-
 @
-
-However some of these (eg 0000010) correspond to
-patterns in which every region at least one set is empty.
-<<>>=
-vsnames <- names(E1)[1:7]
-vsmat <- do.call(rbind,strsplit(vsnames,split=""))
-isa <- vsnames[vsmat[,1]=="1"]
-isb <- vsnames[vsmat[,2]=="1"]
-isc <- vsnames[vsmat[,3]=="1"]
-
-havea <- apply(Eclass[,isa],1,sum)>0
-haveb <- apply(Eclass[,isb],1,sum)>0
-havec <- apply(Eclass[,isc],1,sum)>0
-
-Ehave <- Eclass[havea & haveb & havec,]
-rownames(Ehave) <- 1:nrow(Ehave)
-@
 There are \Sexpr{nrow(Ehave)} patterns with all sets
 represented
 <<results=tex>>=
@@ -116,13 +58,13 @@
 @
 
 <<>>=
-E3List <- lapply(Ehave$VS,function(VS){
-	Weights <- t(Ehave[Ehave$VS==VS,2:8])[,1]
+E3List <- lapply(Ehave3$ESignature,function(VS){
+	Weights <- t(Ehave3[Ehave3$ESignature==VS,2:8])[,1]
 	Weights["000"] <- 0
 	Weights <- Weights[order(names(Weights))]
 	Weights
 })
-names(E3List) <- Ehave$VS
+names(E3List) <- Ehave3$ESignature
 
 efails <- sapply(names(E3List),function(x) {
 	V <- Venn(Weight=E3List[[x]],SetNames=LETTERS[1:3])