[Vennerable-commits] r45 - in pkg/Vennerable: R inst/doc tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 6 17:57:39 CEST 2009
Author: js229
Date: 2009-08-06 17:57:36 +0200 (Thu, 06 Aug 2009)
New Revision: 45
Modified:
pkg/Vennerable/R/02TissueDrawing.R
pkg/Vennerable/R/Circles.R
pkg/Vennerable/inst/doc/TissueDrawingTest.Rnw
pkg/Vennerable/inst/doc/Venn.Rnw
pkg/Vennerable/tests/bug0521AprilMayNovember.R
Log:
Fix bug 0521 by avoiding tangencies and implement simpler invisible edge creation algorithm
Modified: pkg/Vennerable/R/02TissueDrawing.R
===================================================================
--- pkg/Vennerable/R/02TissueDrawing.R 2009-08-04 21:30:36 UTC (rev 44)
+++ pkg/Vennerable/R/02TissueDrawing.R 2009-08-06 15:57:36 UTC (rev 45)
@@ -1044,7 +1044,8 @@
drawing <- renameFaces(drawing,"DarkMatter",faceName)
# has the effect of treating as an ordinary face
}
- faceCentroid <- .face.centroid(drawing,faceName=faceName);rownames(faceCentroid)<-"centroid"
+ faceCentroid <- .face.centroid(drawing,faceName=faceName);
+ rownames(faceCentroid)<-"centroid"
if (.is.point.within.face(drawing,faceName,faceCentroid)) {
return(faceCentroid)
}
@@ -1052,29 +1053,13 @@
amidpoint <- .find.point.on.face(drawing,faceName)
# create a line from the centroid to past that point, and call it a chord
- # names pc and pmid not used
+ chord.from.xy <- faceCentroid
grad <- faceCentroid-amidpoint; grad <- grad/sqrt(sum(grad^2))
- chord <- newEdgeLines(from="pc",to="pmid",xy=rbind(faceCentroid,amidpoint- 2*grad))
-
- foundList <- list()
+ chord.to.xy <- amidpoint- 2*grad
- for ( edgeName in .faceEdgeNames(drawing,faceName,unsigned=TRUE) ) {
- faceEdge <- drawing at edgeList[[edgeName]]
- found <- .findIntersection(chord,faceEdge)
- foundList[[edgeName]] <- found
- }
- # now we have a collection of points at which the chord crosses the face
- ipoints <- do.call(rbind,lapply(names(foundList),
- function(x){y<-foundList[[x]];if(nrow(y)>0){rownames(y)<-paste(x,seq_len(nrow(y)),sep=";")};y})
- )
- # we want to order them along the line of the chord
- npoints <- rbind(ipoints,faceCentroid)
- bottom <- npoints[npoints[,2]==min(npoints[,2]),,drop=FALSE]
- bottomleft <- bottom[bottom[,1]==min(bottom[,1]),,drop=FALSE]
+ npoints <- .probe.chord.intersections(drawing,faceName,chord.from.xy,chord.to.xy)
- dist <- (npoints[,1]-bottomleft[1])^2+(npoints[,2]-bottomleft[2])^2
- npoints <- npoints[order(dist),]
cix <- which(rownames(npoints)=="centroid")
if (cix-2 > 0) {
q1 <- npoints[cix-2,,drop=FALSE];
@@ -1536,60 +1521,176 @@
}
-.addNonintersectingFace <- function(new1,drawing2,tempface2Name) {
+.addNonintersectingFace <- function(drawing1,drawing2,tempface2Name) {
+ # drawing2 contains a single face
#must be inside one of the faces or outside them all
- #either way can add the new face unchanged
-
- res <- addFace(drawing=new1,faceName=tempface2Name,faceSignature="dummy",face=getFace(drawing2,tempface2Name))
- new1 <- res$drawing; tempface2Name<- res$faceName
- aPoint <- drawing2 at nodeList[[1]]
- outerFaceName <- ""
- for (faceName in .faceNames(new1)) {
- if(.is.point.within.face(drawing=new1,faceName=faceName,point.xy=aPoint)) {
- outerFaceName <- faceName
- break
- }
+ #either way can add the new face unchanged to the faceList
+
+ res <- addFace(drawing=drawing1,faceName=tempface2Name,faceSignature="dummy",face=getFace(drawing2,tempface2Name))
+ new1 <- res$drawing; tempface2Name<- res$faceName
+
+ # then find which face it is within, first so we can set the signature correctly
+ aPoint <- .find.point.within.face(drawing2,tempface2Name)
+ outerFaceName <- ""
+ for (faceName in .faceNames(new1)) {
+ if(.is.point.within.face(drawing=new1,faceName=faceName,point.xy=aPoint)) {
+ outerFaceName <- faceName
+ break
}
-#cat(sprintf("found in %s\n",outerFaceName))
- new1 <- setSignature(new1,tempface2Name,.faceSignatures(new1)[[outerFaceName]])
+ }
+ new1 <- setSignature(new1,tempface2Name,.faceSignatures(new1)[[outerFaceName]])
- # but then need to add invisible edges to join in to rest of drawing
- res <- .create.edge.joining.faces(drawing=new1,outerFaceName=outerFaceName ,innerFaceName=tempface2Name )
+ # but then need to add invisible edges to join in to rest of drawing
+ res <- .create.edge.joining.faces(drawing=new1,outerFaceName=outerFaceName ,innerFaceName=tempface2Name )
if (!res$ok) {
return(NA)
}
- iedgeName <- res$edgeName; new1 <- res$drawing;
- redgeName <- paste("-",iedgeName,sep="")
+ iedgeName <- res$edgeName; new1 <- res$drawing;
+ redgeName <- paste("-",iedgeName,sep="")
- # point to attach to (called outer because I imagined the face being inside,
- # but also works when inserting a new face into dark matter and this point
- outerPoint <- new1 at edgeList[[iedgeName ]]@from
- innerPoint <- new1 at edgeList[[iedgeName ]]@to
- drawing2 <- .startFaceAtPoint(drawing2,tempface2Name,innerPoint)
-
- newEdges <- c(iedgeName,getFace(drawing2,tempface2Name,reverse=TRUE),redgeName)
- # find the edge going in to it
- outerEdges <- .face.to.faceEdges(new1,outerFaceName)
- edgetoPoint <- names(outerEdges)[min(which(sapply(outerEdges,function(edge)edge at to==outerPoint)))]
- # normally when replacing edges we want to do it for both faces containing the edge,
- # but not in this case hence doReverse=FALSE
- new1 <- spliceEdgeIntoFace (drawing=new1,faceName=outerFaceName,edgeName=edgetoPoint,edgeNames=c(edgetoPoint,newEdges),doReverse=TRUE)
- # now calculate the names
- oldFaceNames <- .faceNames(new1); faceNames <- oldFaceNames
- notInvolved <- !faceNames %in% c(tempface2Name,"DarkMatter")
- faceNames[ notInvolved ] <- paste(faceNames[ notInvolved ],"0",sep="")
- if (outerFaceName=="DarkMatter") {
- face2Name <- paste(c(rep("0",length(new1 at setList)-1),"1"),collapse="")
- } else {
- face2Name <- paste(outerFaceName,"1",sep="")
- }
- faceNames[ faceNames ==tempface2Name] <- face2Name
- new1 <- renameFaces(new1,oldFaceNames,faceNames)
- new1 <- updateSignature(new1,faceNames[notInvolved],"0")
- new1 <- updateSignature(new1,face2Name,"1")
+ # point to attach to (called outer because I imagined the face being inside,
+ # but also works when inserting a new face into dark matter and this point
+ outerPoint <- new1 at edgeList[[iedgeName ]]@from
+ innerPoint <- new1 at edgeList[[iedgeName ]]@to
+ new1 <- .startFaceAtPoint(new1,tempface2Name,innerPoint)
+ newEdges <- c(iedgeName,getFace(new1,tempface2Name,reverse=TRUE),redgeName)
+ # find the edge going in to it
+ outerEdges <- .face.to.faceEdges(new1,outerFaceName)
+ edgetoPoint <- names(outerEdges)[min(which(sapply(outerEdges,function(edge)edge at to==outerPoint)))]
+ # normally when replacing edges we want to do it for both faces containing the edge,
+ # but not in this case hence doReverse=FALSE
+ new1 <- spliceEdgeIntoFace (drawing=new1,faceName=outerFaceName,edgeName=edgetoPoint,edgeNames=c(edgetoPoint,newEdges),doReverse=TRUE)
+ # now calculate the names
+ oldFaceNames <- .faceNames(new1); faceNames <- oldFaceNames
+ notInvolved <- !faceNames %in% c(tempface2Name,"DarkMatter")
+ faceNames[ notInvolved ] <- paste(faceNames[ notInvolved ],"0",sep="")
+ if (outerFaceName=="DarkMatter") {
+ face2Name <- paste(c(rep("0",length(new1 at setList)-1),"1"),collapse="")
+ } else {
+ face2Name <- paste(outerFaceName,"1",sep="")
+ }
+ faceNames[ faceNames ==tempface2Name] <- face2Name
+ new1 <- renameFaces(new1,oldFaceNames,faceNames)
+ new1 <- updateSignature(new1,faceNames[notInvolved],"0")
+ new1 <- updateSignature(new1,face2Name,"1")
new1
}
+.find.point.in.diagram <- function(drawing,aPoint) {
+ xy <- do.call(rbind,drawing at nodeList)
+ dist <- (xy[,1]-aPoint[1])^2 + (xy[,2]-aPoint[2])^2
+ isEqual <- fequal(dist,0)
+ if (!any(isEqual)) { return(NA)}
+ if (length(which(isEqual))>1) stop("A third nonuique point")
+ pointName <- rownames(xy)[isEqual]
+ return(pointName)
+}
+
+.create.edge.joining.faces <- function(drawing,outerFaceName,innerFaceName) {
+ # if outerFaceName is DarkMatter, then we really want to connect any
+ # one of the other faces to innerFaceName, and the idea is to draw a line joining the centres of the two faces
+ # that must have at least one segment which joins (something connected to the first face) to (something connected to) the second face
+ # if outerFaceName is a regular face, (and then the innerFace is actually nested inside it, hence the names
+ # then a point on its boundary will do as well
+ # in practice the second face is always a single set though
+
+ if (outerFaceName=="DarkMatter") {
+ outerFaceForPoint <- setdiff(.faceNames(drawing),"DarkMatter")[1]
+ outerPoint <- .find.point.within.face(drawing,outerFaceForPoint )
+ } else {
+ outerFaceForPoint <- outerFaceName
+ outerPointName <- .points.of.face(drawing,outerFaceName)
+ outerPoint <- drawing at nodeList[[outerPointName]]
+ }
+ innerPoint <- .find.point.within.face(drawing,innerFaceName)
+ rownames(outerPoint) <- ".cejf"
+
+ # find all the places it hits the 'inner' ie single set face
+ innerpoints <- .probe.chord.intersections(drawing,innerFaceName,outerPoint ,innerPoint )
+ innerpoints <- innerpoints [rownames(innerpoints ) != ".cejf",,drop=FALSE]
+ # and all the points it hits things connected to the outer face, so have to look through all the other faces too
+ outerpoints <- matrix(nrow=0,ncol=2)
+ for (faceName in setdiff(.faceNames(drawing),c("DarkMatter",innerFaceName))) {
+ opoints <- .probe.chord.intersections(drawing,faceName ,outerPoint ,innerPoint )
+ outerpoints <- rbind(outerpoints,opoints )
+ outerpoints <- unique(outerpoints [rownames(outerpoints ) != ".cejf",,drop=FALSE])
+ }
+ # code the points by 1 or 2 depending on whether they are on the inner or outer faces
+ linepoints <- rbind(cbind(outerpoints,1),cbind(innerpoints,2))
+ dist <- (linepoints[,1]-outerPoint [1])^2+(linepoints[,2]-outerPoint [2])^2
+ # sort by distance from the outer set
+ linepoints <- linepoints[order(dist),,drop=FALSE]
+ lastOuter <- max(which(linepoints[,3]==1))
+ stopifnot(lastOuter < nrow(linepoints)) # because there should be at least one inner intersection
+ # now we have a point that will work..it may already be in the diagram but if not must inject it
+ op <- linepoints[lastOuter,1:2,drop=FALSE]
+ opName <- .find.point.in.diagram(drawing,op)
+ if (is.na(opName)) {
+ opEdge <- strsplit(rownames(op),";")[[1]][1]
+ nix <- .node.number.unused(drawing)
+ opName <- paste("e",nix,sep="")
+ rownames(op) <- opName
+ drawing <- injectPoint(drawing,opEdge,op)
+ } else {
+ rownames(op) <- opName
+ }
+ ip <- linepoints[lastOuter+1,1:2,drop=FALSE]
+ ipName <- .find.point.in.diagram(drawing,ip)
+ if (is.na(ipName)) {
+ ipEdge <- strsplit(rownames(ip),";")[[1]][1]
+ nix <- .node.number.unused(drawing)
+ ipName <- paste("e",nix,sep="")
+ rownames(ip) <- ipName
+ drawing <- injectPoint(drawing,ipEdge,ip)
+ } else {
+ rownames(ip) <- ipName
+ }
+
+ xy <- do.call(rbind,drawing at nodeList[c(opName,ipName)])
+ testEdge <- newEdgeLines(from=opName,to=ipName,xy=xy,visible=FALSE)
+ stopifnot(!.internal.edge.drawing.intersection(drawing,testEdge))
+
+ edgeName <- paste(opName,ipName,"invisible",sep="|")
+ tel <- list(testEdge); names(tel) <- edgeName
+ drawing at edgeList <- c(drawing at edgeList,tel)
+ return(list(edgeName=edgeName,drawing=drawing,ok=TRUE))
+
+}
+
+.probe.chord.intersections <- function(drawing,faceName,chord.from.xy,chord.to.xy) {
+ # given two points, chord.from.xy outside the face, and a second point chord.to.xy,
+ # draw a line between the two, and see where the line intersects the face.
+ # then arrange all of these intersection points in the order they appear in along the line,
+ # including the chord.from.xy point
+
+ # names pc and pmid not used
+ chord <- newEdgeLines(from="pc",to="pmid",xy=rbind(chord.from.xy,chord.to.xy))
+
+ foundList <- list()
+
+ for ( edgeName in .faceEdgeNames(drawing,faceName,unsigned=TRUE) ) {
+ faceEdge <- drawing at edgeList[[edgeName]]
+ found <- .findIntersection(chord,faceEdge)
+ foundList[[edgeName]] <- found
+ }
+ # now we have a collection of points at which the chord crosses the face
+ ipoints <- do.call(rbind,lapply(names(foundList),
+ function(x){y<-foundList[[x]];if(nrow(y)>0){rownames(y)<-paste(x,seq_len(nrow(y)),sep=";")};y})
+ )
+ # we want to order them along the line of the chord
+ npoints <- rbind(ipoints,chord.from.xy)
+
+ bottom <- npoints[npoints[,2]==min(npoints[,2]),,drop=FALSE]
+ bottomleft <- bottom[bottom[,1]==min(bottom[,1]),,drop=FALSE]
+
+ dist <- (npoints[,1]-bottomleft[1])^2+(npoints[,2]-bottomleft[2])^2
+ npoints <- npoints[order(dist),,drop=FALSE]
+ npoints
+
+}
+
+
+
.addIntersectingFace <- function(new1,new2,tempface2Name,face2IntersectionPoints) {
# for each intersection point there is a (set of) edges of face2 to the next intersection
# point that we need to add as a (multiple) edge
@@ -1652,6 +1753,7 @@
faceEdgeList
}
+if(FALSE){
.create.edge.joining.faces <- function(drawing,outerFaceName,innerFaceName) {
outerPoints <- .points.of.face(drawing,outerFaceName)
innerPoints <- .points.of.face(drawing,innerFaceName)
@@ -1680,8 +1782,10 @@
return(list(edgeName=edgeName,drawing=drawing,ok=TRUE))
}
+}
+
.internal.edge.drawing.intersection <- function(drawing,edge) {
for (edgeName in names(drawing at edgeList)) {
found <- .findIntersection(edge1=drawing at edgeList[[edgeName]],edge2=edge)
@@ -1713,11 +1817,15 @@
.find.point.in.nodelist(drawing1,drawing2 at nodeList[[pointName]])
}
+.node.number.unused <- function(drawing) {
+ max(as.numeric(gsub("[^0-9]","",c(names(drawing at nodeList)))))+1
+}
+
.add.intersection.points <- function(drawing1,drawing2) {
new1 <- drawing1; new2 <- drawing2;
intersectionPoints <- character(0);
# max number used in nodenames to avoid clashes
- nix <- max(as.numeric(gsub("[^0-9]","",c(names(drawing1 at nodeList),names(drawing2 at nodeList)))))
+ nix <- max(.node.number.unused(drawing1),.node.number.unused(drawing2))
fres <- NULL
for (edgeName1 in names(drawing1 at edgeList)) {
for (edgeName2 in names(new2 at edgeList)) {
Modified: pkg/Vennerable/R/Circles.R
===================================================================
--- pkg/Vennerable/R/Circles.R 2009-08-04 21:30:36 UTC (rev 44)
+++ pkg/Vennerable/R/Circles.R 2009-08-06 15:57:36 UTC (rev 45)
@@ -78,6 +78,7 @@
wAB <- as.numeric(Weight["11"])
inneroff <- 1 # set = 2 to put inner circles completely inside
+ outeroff <- 1.01 # =1 to have exact adjacency
r1 <- sqrt( (wAb+wAB)/pi)
r2 <- sqrt( (waB+wAB)/pi) # area proportional to weights
@@ -94,7 +95,7 @@
d <- (r1-r2)+0.1*r1
}
} else if (wAB==0) {
- d <- inneroff * (r1+r2) # no intersection
+ d <- outeroff * (r1+r2) # no intersection
if (!doEuler) {
d <- 0.95 * d
}
Modified: pkg/Vennerable/inst/doc/TissueDrawingTest.Rnw
===================================================================
--- pkg/Vennerable/inst/doc/TissueDrawingTest.Rnw 2009-08-04 21:30:36 UTC (rev 44)
+++ pkg/Vennerable/inst/doc/TissueDrawingTest.Rnw 2009-08-06 15:57:36 UTC (rev 45)
@@ -62,13 +62,28 @@
\tableofcontents
\newpage
+\section{The VDedgeDrawn object}
+A \texttt{VDedgeDrawn} object encodes a description of an edge. It has two subclasses, representing polygons and circular segments.
+Edges are unique. If two set boundaries overlap they are described by a common edge on the overlap.
+ The orientation of an edge is important. An edge whose name starts with a '-' is
+interpreted as the reversal of the edge with the same name without the '-' (and only the latter is stored in the diagram's list of edges).
+Edge names are unique.
-\section{The VDedgeSector object}
+Most edges form the boundaries of both Faces and Sets. The exception is invisible edges which are added between otherwise disjoint sets
+to ensure the diagram is not disjoint.
-A sector is a segment of a circle, defined by two points, together with the convention that a right-handed sector goes clockwise.
+
+\subsection{The VDedgeSector object}
+A \texttt{VDedgeSector} object inherits from a \texttt{VDedgeDrawn} one.
+A sector is a segment of a circle, defined by two points,
+together with the convention that a right-handed sector goes clockwise (Figure \ref{fig:vds}).
+Angles are all interpreted in the same way as \texttt{acos2} ie clockwise from the line $y=0$.
+The angles of the beginning $\theta_f$ and end $\theta_t$ of the segment obey $2\pi\geq \theta_f > 0$ and $\theta_f>\theta_t>-2*pi$.
+
+
\begin{figure}[H]\begin{center}
-<<defVDedgeSector,fig=TRUE>>=
+<<defVDedgeSector,fig=TRUE,echo=FALSE>>=
nodeList <- list(p1=matrix(1:2,ncol=2),p2=matrix(2:3,ncol=2))
centre = c(-1,5)
fromTheta <- .point.xy.to.theta(nodeList[["p1"]],centre)
@@ -82,7 +97,7 @@
VD1 <- new("TissueDrawing",nodeList=nodeList)
grid.newpage();pushViewport(plotViewport(c(1,1,1,1)))
-makevp.eqsc(c(-7,7),c(-5,10))
+makevp.eqsc(c(-6,4),c(0,9))
grid.xaxis()
grid.yaxis()
PlotNodes(VD1)
@@ -90,10 +105,72 @@
lh at hand <- -1
xy <- .edge.to.xy(lh); grid.lines(xy[,1],xy[,2],default.units="native",arrow=arrow(),gp=gpar(col="red"))
@
+\caption{In black, a right-handed edge sector, and in red a left-handed one}
+\label{fig:vds}
\end{center}\end{figure}
+\subsection{The VDedgeLines object}
+A \texttt{VDedgeSector} object inherits from a \texttt{VDedgeDrawn} one and describes polygonal edges.
-We can also split VDedgeSectors
+\subsection{Edge methods}
+Edges can be shown, split at a point, converted to $xy$ coordinates, or reversed. It can have a 'midpoint' found on its interior.
+A point can be tested to see if it lies on an edge.
+Pairs of edges can be tested for identity, joined together (not much used and barely tested), and crucially
+can be tested for intersection.
+
+
+\section{Faces}
+Individual faces within a diagram are stored as a vector of edge names describing an oriented traversal of the face.
+
+\begin{figure}[H]\begin{center}
+<<shoFace,fig=TRUE,echo=FALSE>>=
+centre1 <- c(0,0)
+nodeList <- list(p1=matrix(c(-1,0),ncol=2),p2=matrix(c(1,0),ncol=2))
+fromTheta1 <- .point.xy.to.theta(nodeList[["p1"]],centre1)
+toTheta1 <- .point.xy.to.theta(nodeList[["p2"]],centre1)
+lh1 <- newEdgeSector(centre=centre1 ,hand=1,from="p1",to="p2",fromTheta=fromTheta1,toTheta=toTheta1,radius=1)
+centre2 <- c(0,-.1)
+fromTheta2 <- .point.xy.to.theta(nodeList[["p2"]],centre2)
+toTheta2 <- .point.xy.to.theta(nodeList[["p1"]],centre2)
+radius2 <- sqrt(sum((nodeList[["p1"]]-centre2)^2))
+lh2 <- newEdgeSector(centre=centre2 ,hand=-1,from="p2",to="p1",fromTheta=fromTheta2,toTheta=toTheta2,radius=radius2)
+lh2 <- .normalise.sector(lh2)
+edgeList <- list(lh1=lh1,lh2=lh2)
+faceList <- list("1"=c("lh1","lh2"))
+setList <- faceList
+faceSignature <- list("1"="1")
+
+VD1 <- new("TissueDrawing",nodeList=nodeList,edgeList=edgeList,faceList=faceList,setList=setList,faceSignature=faceSignature)
+grid.newpage();
+makevp.eqsc(c(-2,2),c(-2,2))
+PlotNodes(VD1)
+PlotSetBoundaries(VD1)
+# centroid is not in face
+aPoint <- .find.point.within.face(drawing=VD1,faceName="1")
+grid.points(x=aPoint[1],y=aPoint[2],default.units="native",pch=4)
+@
+\caption{A face which doesn't contain its centroid}.
+\label{fig:vds}
+\end{center}\end{figure}
+
+\section{Joining disjoint faces}
+
+<<defjoint>>=
+VD2 <- compute.Venn(Venn(n=2))
+VD3 <- newTissueFromCircle (centre.xy =c(2,0), radius=.6,Set=3)
+VD23 <- VD2
+VD23 at faceList <- c(VD2 at faceList,VD3 at faceList)
+VD23 at edgeList <- c(VD2 at edgeList,VD3 at edgeList)
+VD23 at setList <- c(VD2 at setList,VD3 at setList)
+grid.newpage()
+pushViewport(plotViewport(c(1,1,1,1)))
+makevp.eqsc(c(-2,3),c(-2,2));grid.xaxis();grid.yaxis()
+PlotSetBoundaries(VD23)
+
+drawing <- VD23
+innerFaceName <- "1"
+.create.edge.joining.faces(drawing,"DarkMatter","1")
+@
\section{The TissueDrawing object}
First we test constucting them from scratch.
@@ -363,8 +440,8 @@
y <- d*sin(angles)
r <- rep(r,3)
centres <- matrix(c(x,y),ncol=2,byrow=FALSE)
- VDC1 <- newTissueFromCircle(centres[1,],radius=r[1],Set=1,nodes=3);
- VDC2 <- newTissueFromCircle(centres[2,],radius=r[2],Set=2,nodes=3);
+ VDC1 <- newTissueFromCircle(centres[1,],radius=r[1],Set=1);
+ VDC2 <- newTissueFromCircle(centres[2,],radius=r[2],Set=2);
TM <- addSetToDrawing (drawing1=VDC1,drawing2=VDC2,set2Name="Set2")
VDC3 <- newTissueFromCircle(centres[3,],radius=r[3],Set=3);
TM <- addSetToDrawing (drawing1=TM,drawing2=VDC3,set2Name="Set3")
@@ -386,8 +463,8 @@
<<noc>>=
centre.xy <- c(0,-2)
-VDC1 <- newTissueFromCircle(centre.xy,radius=2,Set=1,nodes=4)
-VDC2 <- newTissueFromCircle(centre.xy+c(0,3.5),radius=1,Set=2,nodes=4)
+VDC1 <- newTissueFromCircle(centre.xy,radius=2,Set=1)
+VDC2 <- newTissueFromCircle(centre.xy+c(0,3.5),radius=1,Set=2)
TN2 <- addSetToDrawing(VDC1,VDC2)
VDC3 <- newTissueFromCircle(c(0,-.5),radius=1,Set=3)
.validateDrawing(TN2)
@@ -407,7 +484,7 @@
\subsection{Example of bug 528}
<<nocbug>>=
centre.xy <- c(0,-2)
-VDC1b <- newTissueFromCircle(centre.xy,radius=2,Set=1,nodes=4)
+VDC1b <- newTissueFromCircle(centre.xy,radius=2,Set=1)
VDC2b <- newTissueFromCircle(centre.xy+c(0,3),radius=1,Set=2)
TN2b <- (addSetToDrawing(VDC1b,VDC2b))
TN2b
@@ -420,9 +497,9 @@
makevp.eqsc(c(-3,3),c(-5,5))
grid.xaxis()
grid.yaxis()
-PlotSetBoundaries(VDC1b);PlotNodes(VDC1b)
-PlotSetBoundaries(VDC2b);PlotNodes(VDC2b)
-shoar(VDC1b);shoar(VDC2b)
+PlotSetBoundaries(TN2b)
+PlotNodes(TN2b)
+shoar(TN2b)
@
\end{center}\end{figure}
@@ -639,8 +716,7 @@
PlotSetBoundaries(VDO)
.PlotFaceNames.TissueDrawing (VDO)
PlotNodes(VDO)
-lapply(VDO at edgeList,function(lh){xy <- .edge.to.xy(lh); grid.lines(xy[,1],xy[,2],default.units="native",arrow=arrow())})
-
+shoar(VDO)
@
\end{center}\end{figure}
@@ -818,8 +894,8 @@
x <- c(0.000000, 1.350138 ,-1.086542)
y <- c(1.2615663, -0.8066661, -0.4028718)
centres <- matrix(c(x,y),ncol=2,byrow=FALSE)
- VDC1 <- newTissueFromCircle(centres[1,],radius=r[1],Set=1,nodes=5);
- VDC2 <- newTissueFromCircle(centres[2,],radius=r[2],Set=2,nodes=5);
+ VDC1 <- newTissueFromCircle(centres[1,],radius=r[1],Set=1);
+ VDC2 <- newTissueFromCircle(centres[2,],radius=r[2],Set=2);
TM <- addSetToDrawing (drawing1=VDC1,drawing2=VDC2,set2Name="Set2")
VDC3 <- newTissueFromCircle(centres[3,],radius=r[3],Set=3);
TM <- addSetToDrawing (drawing1=TM,drawing2=VDC3,set2Name="Set3")
@@ -840,42 +916,37 @@
@
\end{center}\end{figure}
-
-\subsection{Three circles one tangent}
-<<circ33b>>=
+\subsection{Two circles tangent numerics}
+<<circ323b>>=
r <- c( 1.492705, 0.977205, 1.128379)
x <- c(0.000000, 1.384666, -1.028597 )
y <- c(1.49270533, -0.55257134, -0.02662434 )
- centres <- matrix(c(x,y),ncol=2,byrow=FALSE)
- VDC1b <- newTissueFromCircle(centres[1,],radius=r[1],Set=1,nodes=6);
- VDC2b <- newTissueFromCircle(centres[2,],radius=r[2],Set=2,nodes=2);
- TMb <- addSetToDrawing (drawing1=VDC1b,drawing2=VDC2b,set2Name="Set2")
- VDC3b <- newTissueFromCircle(centres[3,],radius=r[3],Set=3);
- TM3b <- addSetToDrawing (drawing1=TMb,drawing2=VDC3b,set2Name="Set3")
- TV3b <- .merge.faces.invisibly.split(TM3b)
+centres <- matrix(c(x,y),ncol=2,byrow=FALSE)
+VDC12b <- newTissueFromCircle(centres[1,],radius=r[1],Set=1);
+VDC22b <- newTissueFromCircle(centres[2,],radius=r[2],Set=2);
+TM2b <- try( addSetToDrawing (drawing1=VDC12b,drawing2=VDC22b,set2Name="Set2"))
@
\begin{figure}[H]\begin{center}
-<<shoVDtasng4b,fig=TRUE>>=
+<<shoVD2tasng4b,fig=TRUE>>=
grid.newpage();pushViewport(plotViewport(c(1,1,1,1)))
makevp.eqsc(c(-3,3),c(-3,3))
grid.xaxis();grid.yaxis()
-PlotFaces(TV3b)
-PlotSetBoundaries(TV3b)
-PlotNodes(TV3b)
-
+PlotSetBoundaries(VDC1b); PlotSetBoundaries(VDC2b)
@
+\caption{Numerical difficulties cause a bug here}
\end{center}\end{figure}
+
\subsection{April May June}
<<circ33c>>=
r <- c( 1.261566261010080, 0.977205023805840, 1.128379167095513)
x <- c( 0.000000000000000 , 1.194972714052796 ,-1.194972714052796 )
y <- c( 1.261566261010080, -0.808187193387839, -0.808187193387839 )
centres <- matrix(c(x,y),ncol=2,byrow=FALSE)
- VDC1c <- newTissueFromCircle(centres[1,],radius=r[1],Set=1,nodes=4);
- VDC2c <- newTissueFromCircle(centres[2,],radius=r[2],Set=2,nodes=4);
+ VDC1c <- newTissueFromCircle(centres[1,],radius=r[1],Set=1);
+ VDC2c <- newTissueFromCircle(centres[2,],radius=r[2],Set=2);
TMc <- addSetToDrawing (drawing1=VDC1c,drawing2=VDC2c,set2Name="Set2")
VDC3c <- newTissueFromCircle(centres[3,],radius=r[3],Set=3);
TM3c <- addSetToDrawing (drawing1=TMc,drawing2=VDC3c,set2Name="Set3")
Modified: pkg/Vennerable/inst/doc/Venn.Rnw
===================================================================
--- pkg/Vennerable/inst/doc/Venn.Rnw 2009-08-04 21:30:36 UTC (rev 44)
+++ pkg/Vennerable/inst/doc/Venn.Rnw 2009-08-06 15:57:36 UTC (rev 45)
@@ -5,9 +5,9 @@
<<defmakeme,echo=FALSE,eval=FALSE>>=
makeme <- function() {
- library(weaver)
setwd("C:/JonathanSwinton/Vennerable/pkg/Vennerable/inst/doc")
- Sweave(driver="weaver","Venn.Rnw",stylepath=FALSE,use.cache=FALSE)
+ #library(weaver); Sweave(driver="weaver","Venn.Rnw",stylepath=FALSE,use.cache=FALSE)
+ Sweave("Venn.Rnw",stylepath=FALSE)
}
makeme()
@
Modified: pkg/Vennerable/tests/bug0521AprilMayNovember.R
===================================================================
--- pkg/Vennerable/tests/bug0521AprilMayNovember.R 2009-08-04 21:30:36 UTC (rev 44)
+++ pkg/Vennerable/tests/bug0521AprilMayNovember.R 2009-08-06 15:57:36 UTC (rev 45)
@@ -2,7 +2,7 @@
setList <- strsplit(month.name,split="")
names(setList) <- month.name
Vempty2 <- VennFromSets( setList[c(4,5,11)])
-TJAM <- compute.Venn(Vempty2)
-.validateDrawing(TJAM)
-plot(TJAM)
+TAMN <- compute.Venn(Vempty2)
+.validateDrawing(TAMN )
+#grid.newpage();plot(TAMN )
More information about the Vennerable-commits
mailing list