diagram: Functions for visualising simple graphs (networks), plotting...
In diagram: Functions for Visualising Simple Graphs (Networks), Plotting Flow Diagrams
Description
Details
Author(s)
See Also
Examples
Description
Visualises simple graphs (networks) based on a transition matrix, utilities
to plot flow diagrams, visualising webs,...
Support for the book "A practical guide to ecological modelling -
using R as a simulation platform"
by Karline Soetaert and Peter M.J. Herman (2009). Springer.
and for the book "Solving Differential Equations in R"
by Karline Soetaert, Jeff R. Cash and Francesca Mazzia (in press). Springer.
Details
Package: diagram
Type: Package
Version: 1.6
Date: 2011-06-01
License: GNU Public License 2 or above
This package is used in R-package ecolMod, which includes many more examples.
Author(s)
Karline Soetaert (Maintainer)
See Also
plotmat, plotweb, coordinates,
openplotmat,
arrows:
bentarrow,
curvedarrow, segmentarrow,
selfarrow, splitarrow,
straightarrow, treearrow,
boxes and text:
shadowbox, textdiamond,
textellipse, textempty, texthexa,
textdiamond, textplain, textrect,
textround.
electrical networks:
en.Resistor,en.Capacitator,en.Node,
en.Amplifier,en.Signal en.Ground.
Examples
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
## Not run:
## show examples (see respective help pages for details)
example(plotmat)
example(plotweb)
## run demos
demo("flowchart") # creating flow charts
demo("plotmat") # plotting diagrams inputted as a matrix
demo("plotweb") # plotting webs inputted as a matrix
## open the directory with source code of demos
browseURL(paste(system.file(package="diagram"), "/demo", sep=""))
## show package vignette
vignette("diagram")
edit(vignette("diagram"))
browseURL(paste(system.file(package="diagram"), "/doc", sep=""))
## End(Not run)
Example output
Loading required package: shape
plotmt> M <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), name = c("A", "B", "C", "D"),
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8,
plotmt+ box.size = 0.1, box.type = "square", box.prop = 0.5,
plotmt+ main = "plotmat")
plotmt> pp
$arr
[1] row col
<0 rows> (or 0-length row.names)
$comp
x y
[1,] 0.50 0.8333333
[2,] 0.25 0.5000000
[3,] 0.75 0.5000000
[4,] 0.50 0.1666667
$radii
x y
[1,] 0.1 0.05621547
[2,] 0.1 0.05621547
[3,] 0.1 0.05621547
[4,] 0.1 0.05621547
$rect
xleft ybot xright ytop
[1,] 0.40 0.7771179 0.60 0.8895488
[2,] 0.15 0.4437845 0.35 0.5562155
[3,] 0.65 0.4437845 0.85 0.5562155
[4,] 0.40 0.1104512 0.60 0.2228821
plotmt> # when explicitly given, pos should should be inbetween 0, 1
plotmt> pos <- cbind (c(0.2, 0.4, 0.6, 0.8), c(0.8, 0.6, 0.4, 0.2))
plotmt> pp <- plotmat(M, pos = pos, name = c("A", "B", "C", "D"),
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8,
plotmt+ box.size = 0.1, box.type = "square", box.prop = 0.5,
plotmt+ main = "plotmat")
plotmt> # includes arrows between boxes
plotmt> pm <- par(mfrow = c(2, 2))
plotmt> M <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
plotmt> M[2, 1] <- M[3, 1] <- M[4, 2] <- M[4, 3] <- "f1"
plotmt> col <- M
plotmt> col[] <- "red"
plotmt> col[2, 1] <- col[3, 1] <- "blue"
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0, name = 1:4,
plotmt+ lwd = 1, box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, box.type = "circle",
plotmt+ box.prop = 1.0, main = "plotmat")
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0, name = 1:4,
plotmt+ lwd = 1, box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, box.type = "circle",
plotmt+ box.prop = 1.0, arr.len = 0.3,
plotmt+ segment.from = 0.35, segment.to = 0.65)
plotmt> M[1, 2] <- M[1, 3] <- M[2, 4] <- M[3, 4] <- "f2"
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0.1, name = 1:4,
plotmt+ lwd = 1, box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, box.type = "none",
plotmt+ box.prop = 1.0, main = "plotmat", arr.len = 0.2,
plotmt+ segment.from = 0.3, segment.to = 0.7)
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0.1, name = 1:4,
plotmt+ box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, arr.pos = 0.7,
plotmt+ arr.type = "simple", lwd = 2, box.type = "none",
plotmt+ box.prop = 1.0, main = "plotmat", arr.len = 0.2,
plotmt+ segment.from = 0.3, segment.to = 0.7)
plotmt> par(mfrow=pm)
plotmt> # self arrows
plotmt> diag(M) <- "self"
plotmt> pp <- plotmat(M, pos = c(2, 2), curve = 0, name = LETTERS[1:4],
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8, self.cex = 0.5,
plotmt+ self.shiftx = c(-0.1, 0.1, -0.1, 0.1),
plotmt+ box.type = "diamond", box.prop = 0.5, main = "plotmat")
plotmt> M <- matrix(nrow = 4, ncol = 4, data = 0)
plotmt> M[2, 1]<- 1 ; M[4, 2] <- 2 ; M[3, 4] <- 3; M[1, 3] <- 4
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0.2, name = letters[1:4],
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8, arr.type = "triangle",
plotmt+ box.size = 0.1, box.type = "hexa", box.prop = 0.5,
plotmt+ main = "plotmat")
plotmt> arrlwd <- M*2
plotmt> arr.length <- M*0.4
plotmt> cextxt <- M*0.8
plotmt> plotmat(M, pos = c(1, 2, 1), curve = 0.2, name = letters[1:4], lwd = 1,
plotmt+ box.lwd = 2, arr.type = "triangle", box.size = 0.1,
plotmt+ box.type = "hexa", box.prop = 0.5, main = "plotmat",
plotmt+ arr.lwd = arrlwd, arr.length = arr.length, cex.txt = cextxt)
plotmt> M <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
plotmt> M <- as.data.frame(M)
plotmt> M[[2,1]]<- "k[si]"
plotmt> M[[3,1]]<- "k[N]"
plotmt> M[[4,2]]<- "sqrt(frac(2,3))"
plotmt> names <-
plotmt+ c(expression(lambda[12]), "?",
plotmt+ expression(lambda[13]),expression(lambda[23]))
plotmt> plotmat(M, pos = c(1, 2, 1), name = names, lwd = 1, box.lwd = 2,
plotmt+ curve = 0, cex.txt = 0.8, box.size = 0.1, box.type = "square",
plotmt+ box.prop = 0.5, main = "plotmat")
plotmt> plotmat(M, name = letters[1:4], curve = 0, box.cex = 1:4, box.lwd = 4:1,
plotmt+ box.size = 0.075, arr.pos = 0.7,
plotmt+ box.col = c("lightblue", "green", "yellow", "orange"))
plotwb> plotweb(Rigaweb, main = "Gulf of Riga food web",
plotwb+ sub = "mgC/m3/d", val = TRUE)
plotwb> ArrCol <- Rigaweb
plotwb> ArrCol[] <- "black"
plotwb> ArrCol[,"Sedimentation"] <- "green"
plotwb> plotweb(Rigaweb, main = "Gulf of Riga food web",
plotwb+ sub = "mgC/m3/d", val = FALSE, arr.col = ArrCol)
plotwb> plotweb(diag(20), main = "plotweb")
demo(flowchart)
---- ~~~~~~~~~
> ## Flowchart examples
> par(ask=TRUE)
> ## MODELLING DIAGRAM
> mar <- par(mar=c(1,1,1,1))
> openplotmat(main="from Soetaert and herman, book in prep",cex.main=1)
> elpos<-coordinates (c(1,1,1,1,1,1,1,1),mx=-0.1)
> segmentarrow(elpos[7,],elpos[2,],arr.pos=0.15,dd=0.3,arr.side=3,endhead=TRUE)
> segmentarrow(elpos[7,],elpos[3,],arr.pos=0.15,dd=0.3,arr.side=3,endhead=TRUE)
> segmentarrow(elpos[7,],elpos[4,],arr.pos=0.15,dd=0.3,arr.side=3,endhead=TRUE)
> pin <- par ("pin") # size of plotting region, inches
> xx <- 0.2
> yy <- xx*pin[1]/pin[2]*0.15 # used to make circles round
> sx <- rep(xx,8)
> sx[7] <- 0.05
> sy <- rep(yy,8)
> sy[6] <-yy*1.5
> sy[7] <- sx[7]*pin[1]/pin[2]
> for (i in c(1:7)) straightarrow (to=elpos[i+1,],from=elpos[i,],lwd=2,arr.pos=0.6,endhead=TRUE)
> lab <- c("Problem","Conceptual model","Mathematical model","Parameterisation",
+ "Mathematical solution","","OK?","Prediction, Analysis")
> for (i in c(1:5,8)) textround(elpos[i,],sx[i],sy[i],lab=lab[i])
> textround(elpos[6,],xx,yy*1.5,lab=c("Calibration,sensitivity","Verification,validation"))
> textdiamond(elpos[7,],sx[7],sy[7],lab=lab[7])
> textplain(c(0.7,elpos[2,2]),yy*2,lab=c("main components","relationships"),font=3,adj=c(0,0.5))
> textplain(c(0.7,elpos[3,2]),yy ,"general theory",adj=c(0,0.5),font=3)
> textplain(c(0.7,elpos[4,2]),yy*2,lab=c("literature","measurements"),font=3,adj=c(0,0.5))
> textplain(c(0.7,elpos[6,2]),yy*2,lab=c("field data","lab measurements"),font=3,adj=c(0,0.5))
> #####
> ## DIAGRAM
>
> par(mar=c(1,1,1,1))
> openplotmat()
> elpos<-coordinates (c(1,1,2,4))
> fromto <- matrix(ncol=2,byrow=TRUE,data=c(1,2,2,3,2,4,4,7,4,8))
> nr <-nrow(fromto)
> arrpos <- matrix(ncol=2,nrow=nr)
> for (i in 1:nr)
+ arrpos[i,]<- straightarrow (to=elpos[fromto[i,2],],from=elpos[fromto[i,1],]
+ ,lwd=2,arr.pos=0.6,arr.length=0.5)
> textellipse(elpos[1,],0.1,lab="start",box.col="green",shadow.col="darkgreen",shadow.size=0.005,cex=1.5)
> textrect (elpos[2,],0.15,0.05,lab="found term?",box.col="blue",shadow.col="darkblue",shadow.size=0.005,cex=1.5)
> textrect (elpos[4,],0.15,0.05,lab="related?",box.col="blue",shadow.col="darkblue",shadow.size=0.005,cex=1.5)
> textellipse(elpos[3,],0.1,0.1,lab=c("other","term"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> textellipse(elpos[3,],0.1,0.1,lab=c("other","term"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> textellipse(elpos[7,],0.1,0.1,lab=c("make","a link"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> textellipse(elpos[8,],0.1,0.1,lab=c("new","article"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> dd <- c(0.0,0.025)
> text(arrpos[2,1]+0.05,arrpos[2,2],"yes")
> text(arrpos[3,1]-0.05,arrpos[3,2],"no")
> text(arrpos[4,1]+0.05,arrpos[4,2]+0.05,"yes")
> text(arrpos[5,1]-0.05,arrpos[5,2]+0.05,"no")
> #####
> par(mfrow=c(2,2))
> par(mar=c(0,0,0,0))
> openplotmat()
> elpos<-coordinates (c(2,3))
> treearrow(from=elpos[1:2,],to=elpos[3:5,],arr.side=2,path="H")
> for ( i in 1:5) textrect (elpos[i,],0.15,0.05,lab=i,cex=1.5)
> openplotmat()
> elpos<-coordinates (c(3,2),hor=FALSE)
> treearrow(from=elpos[1:3,],to=elpos[4:5,],arr.side=2,arr.pos=0.2,path="V")
> for ( i in 1:5) textrect (elpos[i,],0.15,0.05,lab=i,cex=1.5)
> openplotmat()
> elpos<-coordinates (c(1,4))
> treearrow(from=elpos[1,],to=elpos[2:5,],arr.side=2,arr.pos=0.7,path="H")
> for ( i in 1:5) textrect (elpos[i,],0.05,0.05,lab=i,cex=1.5)
> openplotmat()
> elpos<-coordinates (c(2,1,2,3))
> elpos[1,1]<-0.3;elpos[2,1]<-0.7
> treearrow(from=elpos[1:3,],to=elpos[4:8,],arr.side=2,path="H")
> for ( i in 1:8) bentarrow(from=elpos[i,],to=elpos[i,]+c(0.1,-0.05),
+ arr.pos=1,arr.type="circle",arr.col="white",arr.length=0.2)
> for ( i in 1:8) textrect (elpos[i,],0.05,0.05,lab=i,cex=1.5)
> mtext(side=3,outer=TRUE,line=-2,"treearrow",cex=1.5)
> par(mfrow=c(1,1))
> par(mar=c(0,0,0,0))
> openplotmat()
> elpos<-coordinates (c(1,1,2,1))
> straightarrow (to=elpos[2,],from=elpos[1,])
> treearrow(from=elpos[2,],to=elpos[3:4,],arr.side=2,path="H")
> treearrow(from=elpos[3:4,],to=elpos[5,],arr.side=2,path="H")
> segmentarrow(from=elpos[5,],to=elpos[2,],dd=0.4)
> curvedarrow(from= elpos[5,],to=elpos[2,],curve=0.8)
> col <- femmecol(5)
> texthexa (mid=elpos[1,],radx=0.1,angle=20,shadow.size=0.01,rady=0.05,lab=1,box.col=col[1])
> textrect (mid=elpos[2,],radx=0.1,shadow.size=0.01,rady=0.05,lab=2,box.col=col[2])
> textround (mid=elpos[3,],radx=0.05,shadow.size=0.01,rady=0.05,lab=3,box.col=col[3])
> textellipse (mid=elpos[4,],radx=0.05,shadow.size=0.01,rady=0.05,lab=4,box.col=col[4])
> textellipse (mid=elpos[5,],radx=0.05,shadow.size=0.01,rady=0.08,angle=45,lab=5,box.col=col[5])
> par(mar=c(1,1,1,1))
> openplotmat(main="Arrowtypes")
> elpos<-coordinates (c(1,2,1),mx=0.1,my=-0.1)
> curvedarrow(from=elpos[1,],to=elpos[2,],curve=-0.5,lty=2,lcol=2)
> straightarrow(from=elpos[1,],to=elpos[2,],lty=3,lcol=3)
> segmentarrow(from=elpos[1,],to=elpos[2,],lty=1,lcol=1)
> treearrow(from=elpos[2:3,],to=elpos[4,],lty=4,lcol=4)
> bentarrow(from=elpos[3,],to=elpos[3,]-c(0.1,0.1),arr.pos=1,lty=5,lcol=5)
> bentarrow(from=elpos[1,],to=elpos[3,],lty=5,lcol=5)
> selfarrow(pos=elpos[3,],path="R",lty=6,curve=0.075,lcol=6)
> splitarrow(from=elpos[1,],to=elpos[2:3,],lty=1,lwd=1,dd=0.7,arr.side=1:2,lcol=7)
> for ( i in 1:4) textrect (elpos[i,],0.05,0.05,lab=i,cex=1.5)
> legend("topright",lty=1:7,legend=c("segmentarrow","curvedarrow","straightarrow",
+ "treearrow","bentarrow","selfarrow","splitarrow"),lwd=c(rep(2,6),1),col=1:7)
> openplotmat(main="textbox shapes")
> rx <- 0.1
> ry <- 0.05
> pos <- coordinates(c(1,1,1,1,1,1,1),mx=-0.2)
> textdiamond(mid=pos[1,],radx=rx,rady=ry,lab=LETTERS[1],cex=2,shadow.col="lightblue")
> textellipse(mid=pos[2,],radx=rx,rady=ry,lab=LETTERS[2],cex=2,shadow.col="blue")
> texthexa(mid=pos[3,],radx=rx,rady=ry,lab=LETTERS[3],cex=2,shadow.col="darkblue")
> textmulti(mid=pos[4,],nr=7,radx=rx,rady=ry,lab=LETTERS[4],cex=2,shadow.col="red")
> textrect(mid=pos[5,],radx=rx,rady=ry,lab=LETTERS[5],cex=2,shadow.col="darkred")
> textround(mid=pos[6,],radx=rx,rady=ry,lab=LETTERS[6],cex=2,shadow.col="black")
> textempty(mid=pos[7,],lab=LETTERS[7],cex=2,box.col="yellow")
> pos[,1] <- pos[,1] + 0.5
> text(pos[,1],pos[,2],c("textdiamond","textellipse","texthexa","textmulti","textrect","textround","textempty"))
> mf<-par(mfrow=c(2,2))
> example(bentarrow)
bntrrw> openplotmat(main = "bentarrow")
bntrrw> pos <- cbind( A <- seq(0.1, 0.9, by = 0.2), rev(A))
bntrrw> text(pos, LETTERS[1:5], cex = 2)
bntrrw> for (i in 1:4)
bntrrw+ bentarrow(from = pos[i,] + c(0.05, 0), to = pos[i+1,] + c(0, 0.05),
bntrrw+ arr.pos = 1, arr.adj = 1)
bntrrw> for (i in 1:2)
bntrrw+ bentarrow(from = pos[i,] + c(0.05, 0), to = pos[i+1, ] + c(0, 0.05),
bntrrw+ arr.pos = 0.5, path = "V", lcol = "lightblue",
bntrrw+ arr.type = "triangle")
bntrrw> bentarrow(from = pos[3, ] + c(0.05, 0), to = pos[4, ] + c(0, 0.05),
bntrrw+ arr.pos = 0.7, arr.side = 1, path = "V", lcol = "darkblue")
bntrrw> bentarrow(from = pos[4, ] + c(0.05, 0), to = pos[5, ] + c(0, 0.05),
bntrrw+ arr.pos = 0.7, arr.side = 1:2, path = "V", lcol = "blue")
> example(coordinates)
crdnts> openplotmat(main = "coordinates")
crdnts> text(coordinates(N = 6), lab = LETTERS[1:6], cex = 2)
crdnts> text(coordinates(N = 8, relsize = 0.5), lab = letters[1:8], cex = 2)
crdnts> openplotmat(main = "coordinates")
crdnts> text(coordinates(pos = c(2, 4, 2)), lab = letters[1:8], cex = 2)
crdnts> plot(0, type = "n", xlim = c(0, 5), ylim = c(2, 8), main = "coordinates")
crdnts> text(coordinates(pos = c(2, 4, 3), hor = FALSE), lab = 1:9, cex = 2)
> par(mfrow=c(2,2))
> example(curvedarrow)
crvdrr> openplotmat(main = "curvedarrow")
crvdrr> pos <- coordinates(pos = 4, my = 0.2)
crvdrr> text(pos, LETTERS[1:4], cex = 2)
crvdrr> for (i in 1:3)
crvdrr+ curvedarrow(from = pos[1, ] + c(0,-0.05), to = pos[i+1, ] + c(0,-0.05),
crvdrr+ curve = 0.5, arr.pos = 1)
crvdrr> for (i in 1:3)
crvdrr+ curvedarrow(from = pos[1, ] + c(0, 0.05), to = pos[i+1, ] + c(0, 0.05),
crvdrr+ curve = -0.25, arr.adj = 1, arr.pos = 0.5,
crvdrr+ arr.type = "triangle", arr.col = "blue")
> example(segmentarrow)
sgmntr> openplotmat(main="segmentarrow")
sgmntr> pos <-cbind(A <- seq(0.2, 0.8, by = 0.2), rev(A))
sgmntr> text(pos, LETTERS[1:4], cex = 2)
sgmntr> segmentarrow(from = pos[1, ] + c(0, 0.05), to = pos[2, ] + c(0, 0.05),
sgmntr+ arr.pos = 1, arr.adj = 1, dd = 0.1,
sgmntr+ path = "UHD", lcol = "darkred")
sgmntr> segmentarrow(from = pos[2, ] + c(-0.05, 0), to = pos[3, ] + c(-0.05, 0.01),
sgmntr+ arr.pos = 1, arr.adj = 1, dd = 0.1,
sgmntr+ lcol = "black", arr.type = "triangle")
sgmntr> segmentarrow(from = pos[2, ] + c(0.05, 0), to = pos[3, ] + c(0.05, 0.01),
sgmntr+ arr.pos = 0.5, dd = 0.3, path = "RVL", arr.side = 1,
sgmntr+ lcol = "lightblue", arr.type = "simple")
sgmntr> segmentarrow(from = pos[3, ] + c(0.05, 0), to = pos[4, ] + c(-0.05, 0.01),
sgmntr+ arr.pos = 0.5, dd = 0.05, path = "RVL", lcol = "darkblue",
sgmntr+ arr.type = "ellipse")
sgmntr> segmentarrow(from = pos[3, ] + c(0, -0.05), to = pos[4, ] + c(0, 0.05),
sgmntr+ arr.pos = 0.5, arr.side = 3, dd = 0.05, path = "DHU",
sgmntr+ lcol = "darkgreen")
sgmntr> segmentarrow(from = pos[3,] + c(-0.05, -0.05), to = pos[4, ] + c(0, -0.05),
sgmntr+ arr.pos = 0.5, arr.side = 1:3, dd = 0.3, path = "DHU",
sgmntr+ lcol = "green")
> example(selfarrow)
slfrrw> openplotmat(main = "selfarrow")
slfrrw> pos <- coordinates(3, mx = 0.05)
slfrrw> text(pos, LETTERS[1:3], cex = 2)
slfrrw> for (i in 1:3)
slfrrw+ selfarrow(pos = pos[i, ], path = "R", arr.pos = 0.2,
slfrrw+ curve = c(0.05, 0.1), lcol = "darkred")
slfrrw> for (i in 1:3)
slfrrw+ selfarrow(pos = pos[i, ], path = "L", arr.pos = 0.7,
slfrrw+ lcol = "darkblue", curve = c(0.05, 0.05))
slfrrw> for (i in 1:3)
slfrrw+ selfarrow(pos = pos[i, ], path = "L", arr.pos = 0.5,
slfrrw+ lcol = "darkgreen", code = i, arr.type = "triangle")
> example(straightarrow)
strght> openplotmat(main = "straightarrow")
strght> pos <- coordinates(c(2, 3, 1))
strght> for (i in 1:5)
strght+ straightarrow(from = pos[i, ], to = pos[i+1, ], arr.pos = 0.5)
strght> straightarrow(from = pos[6, ], to = pos[6, ] + c(0.3, 0.),
strght+ arr.type = "T", arr.pos = 1, arr.lwd = 3)
strght> for (i in 1:6)
strght+ textrect(pos[i, ], lab = LETTERS[i], radx = 0.05)
> par(mfrow=c(2,2))
> example(treearrow)
trerrw> openplotmat(main = "treearrow")
trerrw> pos <- coordinates(c(3, 2, 4, 1))
trerrw> treearrow(from = pos[1:5, ], to = pos[6:10, ])
trerrw> for (i in 1:10)
trerrw+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
trerrw> openplotmat(main = "treearrow")
trerrw> pos <- coordinates(c(2, 4), hor = FALSE)
trerrw> treearrow(from = pos[1:2, ], to = pos[3:6, ],
trerrw+ arr.side = 1:2, path = "V")
trerrw> for (i in 1:6)
trerrw+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
trerrw> openplotmat(main = "treearrow")
trerrw> pos <- coordinates(c(3, 5, 7, 7, 5, 3))
trerrw> treearrow(from = pos[1:15, ], to = pos[15:30, ], arr.side = 0)
trerrw> for (i in 1:30)
trerrw+ textrect(pos[i, ], lab = i, cex = 1.2, radx = 0.025)
> par(mfrow=c(2,2))
> example(splitarrow)
spltrr> openplotmat(main = "splitarrow")
spltrr> pos <- coordinates(c(1, 2, 2, 4, 1))
spltrr> splitarrow(from = pos[1, ], to = pos[2:10, ],
spltrr+ arr.side = 1, centre = c(0.5, 0.625))
spltrr> for (i in 1:10)
spltrr+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
spltrr> openplotmat(main = "splitarrow")
spltrr> pos <- coordinates(c(1, 3))
spltrr> splitarrow(from = pos[1,], to = pos[2:4, ], arr.side = 1)
spltrr> splitarrow(from = pos[1,], to = pos[2:4, ], arr.side = 2)
spltrr> for (i in 1:4)
spltrr+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
spltrr> openplotmat(main = "splitarrow")
spltrr> pos <- coordinates(N = 6)
spltrr> pos <- rbind(c(0.5, 0.5), pos)
spltrr> splitarrow(from = pos[1, ], to = pos[2:7, ], arr.side = 2)
spltrr> for (i in 1:7)
spltrr+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
> par(mfrow=c(2,2))
> example(textdiamond)
txtdmn> openplotmat(xlim = c(-0.1, 1.1), main = "textdiamond")
txtdmn> for (i in 1:10)
txtdmn+ textdiamond(mid = runif(2), col = i, radx = 0.1, rady = 0.05,
txtdmn+ lab = LETTERS[i], cex = 2, angle = runif(1)*360)
> example(textellipse)
txtllp> openplotmat(xlim = c(-0.1, 1.1), main = "textellipse")
txtllp> for (i in 1:10)
txtllp+ textellipse(mid = runif(2), col = i, box.col = grey(0.95),
txtllp+ radx = 0.1, rady = 0.05, lab = LETTERS[i],
txtllp+ cex = 2, angle = runif(1)*360)
> example(textempty)
txtmpt> openplotmat(xlim = c(-0.1, 1.1), col = "lightgrey", main = "textempty")
txtmpt> for (i in 1:10)
txtmpt+ textempty(mid = runif(2), box.col = i, lab = LETTERS[i], cex = 2)
txtmpt> textempty(mid = c(0.5, 0.5), adj = c(0, 0),
txtmpt+ lab = "textempty", box.col = "white")
> example(texthexa)
texthx> openplotmat(xlim = c(-0.1, 1.1), main = "texthexa")
texthx> for (i in 1:20)
texthx+ texthexa(mid = runif(2), angle = runif(1)*360, col = i,
texthx+ box.col = grey(0.95), radx = 0.1, rady = 0.05,
texthx+ lab = LETTERS[i], cex = 2)
> example(textmulti)
txtmlt> openplotmat(xlim = c(-0.1, 1.1), main = "textmulti")
txtmlt> for (i in 1:10)
txtmlt+ textmulti(mid = runif(2), col = i, radx = 0.1, rady = 0.1,
txtmlt+ lab = LETTERS[i], cex = 2, nr = trunc(i/1.5)+3)
> example(textplain)
txtpln> openplotmat(main = "textplain")
txtpln> textplain(mid = c(0.5, 0.5),
txtpln+ lab = c("this text is", "centered", "4 strings", "on 4 lines"))
txtpln> textplain(mid = c(0.5, 0.2), adj = c(0, 0.5), font = 2, height = 0.05,
txtpln+ lab = c("this text is","left alligned"))
txtpln> textplain(mid = c(0.5, 0.8), adj = c(1, 0.5), font = 3, height = 0.05,
txtpln+ lab = c("this text is","right alligned"))
> example(textrect)
txtrct> openplotmat(xlim = c(-0.1, 1.1), main = "textrect")
txtrct> for (i in 1:10)
txtrct+ textrect(mid = runif(2), col = i, radx = 0.1, rady = 0.1,
txtrct+ lab = LETTERS[i], cex = 2)
txtrct> openplotmat(xlim = c(-0.1, 1.1), main = "textparallel")
txtrct> elpos <-coordinates (c(1, 1, 1, 1, 1))
txtrct> textparallel(mid = elpos[1,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=20", theta = 20)
txtrct> textparallel(mid = elpos[2,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=60", theta = 60)
txtrct> textparallel(mid = elpos[3,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=100", theta = 100)
txtrct> textparallel(mid = elpos[4,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=140", theta = 140)
txtrct> textparallel(mid = elpos[5,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=170", theta = 170)
> example(textround)
txtrnd> openplotmat(xlim = c(-0.1, 1.1), main = "textround")
txtrnd> for (i in 1:10)
txtrnd+ textround(mid = runif(2), col = i,
txtrnd+ radx = 0.03, rady = 0.075,
txtrnd+ lab = LETTERS[i], cex = 2)
> par(mfrow=mf)
demo(plotmat)
---- ~~~~~~~
> ### DEMONSTRATION FOR PLOTMAT
> ## plots diagram based on a matrix
>
>
> ## SIMPLE PLOTMAT example
> par(ask=TRUE)
> par(mar=c(1,1,1,1),mfrow=c(2,2))
> names <- c("A","B","C","D")
> M <- matrix(nrow=4,ncol=4,byrow=TRUE,data=0)
> pp<-plotmat(M,pos=c(1,2,1),name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ box.size=0.1,box.type="square",box.prop=0.5)
> M[2,1]<-M[3,1]<-M[4,2]<-M[4,3] <- "flow"
> pp<-plotmat(M,pos=c(1,2,1),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ box.type="circle",box.prop=1.0)
> diag(M) <- "self"
> pp<-plotmat(M,pos=c(2,2),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ self.cex=0.5,self.shiftx=c(-0.1,0.1,-0.1,0.1),
+ box.type="diamond",box.prop=0.5)
> M <- matrix(nrow=4,ncol=4,data=0)
> M[2,1]<-1 ;M[4,2]<-2;M[3,4]<-3;M[1,3]<-4
> pp<-plotmat(M,pos=c(1,2,1),curve=0.2,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ arr.type="triangle",box.size=0.1,box.type="hexa",box.prop=0.5)
> mtext(outer=TRUE,side=3,line=-1.5,cex=1.5,"plotmat")
> ##PLOTMAT example 2
> names <- c("A","B","C","D")
> M <- matrix(nrow=4,ncol=4,byrow=TRUE,data=0)
> M[2,1]<-M[3,2]<-M[4,3]<-1
> par(mfrow=c(1,2))
> pp<-plotmat(M,pos=c(1,1,1,1),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.,
+ box.size=0.2,box.type="square",box.prop=0.5,arr.type="triangle",
+ arr.pos=0.6)
> p2 <-plotmat(M[1:2,1:2],pos=pp$comp[c(1,4),],curve=0,name=names[c(1,4)],lwd=1,box.lwd=2,
+ cex.txt=0.,box.size=0.2,box.type="square",box.prop=0.5,
+ arr.type="triangle",arr.pos=0.6)
> text(p2$arr$ArrowX+0.1,p2$arr$ArrowY,font=3,adj=0,"one flow")
> par(mfrow=c(1,1))
> mtext(outer=TRUE,side=3,line=-1.5,cex=1.5,"plotmat")
> # Plotmat example NPZZDD model
> names <- c("PHYTO","NH3","ZOO","DETRITUS","BotDET","FISH")
> M <- matrix(nrow=6,ncol=6,byrow=TRUE,data=c(
+ # p n z d b f
+ 0,1,0, 0, 0, 0, #p
+ 0,0,4, 10,11,0, #n
+ 2,0,0, 0, 0, 0, #z
+ 8,0,13,0, 0, 12,#d
+ 9,0,0, 7, 0, 0, #b
+ 0,0,5, 0, 0, 0 #f
+ ))
> pp<-plotmat(M,pos=c(1,2,1,2),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ box.type="square",box.prop=0.5,arr.type="triangle",
+ arr.pos=0.4,shadow.size=0.01,prefix="f",
+ main="NPZZDD model, from Soetaert and herman, 2009, Springer")
> # extra arrows: flow 5 to Detritus and flow 2 to detritus
> phyto <-pp$comp[names=="PHYTO"]
> zoo <-pp$comp[names=="ZOO"]
> nh3 <-pp$comp[names=="NH3"]
> detritus<-pp$comp[names=="DETRITUS"]
> fish <-pp$comp[names=="FISH"]
> # flow5->detritus
> m2 <- 0.5*(zoo+fish)
> m1 <- detritus
> m1[1]<-m1[1]+ pp$radii[4,1]
> mid<-straightarrow (to=m1,from=m2,arr.type="triangle",arr.pos=0.4,lwd=1)
> text(mid[1],mid[2]+0.03,"f6",cex=0.8)
> # flow2->detritus
> m2 <- 0.5*(zoo+phyto)
> m1 <- detritus
> m1[1] <-m1[1]+ pp$radii[3,1]*0.2
> m1[2]<-m1[2] + pp$radii[3,2]
> mid<-straightarrow (to=m1,from=m2,arr.type="triangle",arr.pos=0.3,lwd=1)
> text(mid[1]-0.01,mid[2]+0.03,"f3",cex=0.8)
> # TRANSITION MATRIX
>
> par(mfrow=c(2,1))
> #labels as formulae
> Numgenerations <- 6
> # Original Population matrix
> DiffMat <- matrix(data=0,nrow=Numgenerations,ncol=Numgenerations) # declare it
> AA <- as.data.frame(DiffMat)
> AA[[1,4]]<- "f[3]"
> AA[[1,5]]<- "f[4]"
> AA[[1,6]]<- "f[5]"
> AA[[2,1]]<- "s[list(0,1)]"
> AA[[3,2]]<- "s[list(1,2)]"
> AA[[4,3]]<- "s[list(2,3)]"
> AA[[5,4]]<- "s[list(3,4)]"
> AA[[6,5]]<- "s[list(4,5)]"
> name <- c("Age0","Age1","Age2","Age3","Age4","Age5")
> PP <- plotmat(A=AA,pos=6,curve=0.7,name=name,lwd=2,arr.len=0.6,arr.width=0.25,my=-0.2,
+ box.size=0.05,arr.type="triangle",dtext= 0.95,cex.txt=0,
+ main="Age-structured population model 1")
> for (i in 1:nrow(PP$arr))
+ text(as.double(PP$arr[i,"TextX"]),as.double(PP$arr[i,"TextY"]),
+ parse(text=as.character(PP$arr[i,"Value"])))
> # reduced population matrix
> Numgenerations <- Numgenerations-1
> DiffMat <- DiffMat[-1,-1]
> AA <- as.data.frame(DiffMat)
> AA[[1,3]]<- "f[3]*s[list(0,1)]"
> AA[[1,4]]<- "f[4]*s[list(0,1)]"
> AA[[1,5]]<- "f[5]*s[list(0,1)]"
> AA[[2,1]]<- "s[list(0,2)]"
> AA[[3,2]]<- "s[list(2,3)]"
> AA[[4,3]]<- "s[list(3,4)]"
> AA[[5,4]]<- "s[list(4,5)]"
> name <- c("Age0","Age2","Age3","Age4","Age5")
> pos <- PP$comp[-1,]
> PP <- plotmat(AA,pos=pos,curve=0.7,name=name,lwd=2,arr.len=0.6,arr.width=0.25,my=-0.1,
+ box.size=0.05,arr.type="triangle",dtext= 0.95,cex.txt=0,main="Age-structured population model 2")
> for (i in 1:nrow(PP$arr))
+ text(as.double(PP$arr[i,"TextX"]),as.double(PP$arr[i,"TextY"]),
+ parse(text=as.character(PP$arr[i,"Value"])))
> par(mfrow=c(1,1),mar=c(2,2,2,2))
> #################3
> par(mfrow=c(1,1))
> par(mar=c(4,4,4,4))
> par(xaxs="r",yaxs="r")
> # Fecundity and Survival for each generation
> NumClass <- 10
> Fecundity <- c(0, 0.00102,0.08515,0.30574,0.40002,
+ 0.28061,0.1526 ,0.0642 ,0.01483,0.00089)
> Survival <- c(0.9967 ,0.99837,0.9978 ,0.99672,0.99607,
+ 0.99472,0.99240,0.98867,0.98274,NA) # survival from i to i+1
> cbind(Fecundity,Survival)
Fecundity Survival
[1,] 0.00000 0.99670
[2,] 0.00102 0.99837
[3,] 0.08515 0.99780
[4,] 0.30574 0.99672
[5,] 0.40002 0.99607
[6,] 0.28061 0.99472
[7,] 0.15260 0.99240
[8,] 0.06420 0.98867
[9,] 0.01483 0.98274
[10,] 0.00089 NA
> # Population matrix M
> DiffMatrix <- matrix(data=0,nrow=NumClass,ncol=NumClass) # declare it
> DiffMatrix[1,] <- Fecundity # first row: fecundity
> for (i in 1:(NumClass-1)) DiffMatrix[i+1,i] <- Survival[i]
> DiffMatrix # print the matrix to screen
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 0.0000 0.00102 0.08515 0.30574 0.40002 0.28061 0.1526 0.06420 0.01483
[2,] 0.9967 0.00000 0.00000 0.00000 0.00000 0.00000 0.0000 0.00000 0.00000
[3,] 0.0000 0.99837 0.00000 0.00000 0.00000 0.00000 0.0000 0.00000 0.00000
[4,] 0.0000 0.00000 0.99780 0.00000 0.00000 0.00000 0.0000 0.00000 0.00000
[5,] 0.0000 0.00000 0.00000 0.99672 0.00000 0.00000 0.0000 0.00000 0.00000
[6,] 0.0000 0.00000 0.00000 0.00000 0.99607 0.00000 0.0000 0.00000 0.00000
[7,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.99472 0.0000 0.00000 0.00000
[8,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.00000 0.9924 0.00000 0.00000
[9,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.00000 0.0000 0.98867 0.00000
[10,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.00000 0.0000 0.00000 0.98274
[,10]
[1,] 0.00089
[2,] 0.00000
[3,] 0.00000
[4,] 0.00000
[5,] 0.00000
[6,] 0.00000
[7,] 0.00000
[8,] 0.00000
[9,] 0.00000
[10,] 0.00000
> names <- c("0-5yr","5-10yr","10-15yr","15-20yr","20-25yr","25-30yr","30-35yr","35-40yr","40-45yr","45-50yr")
> # first generation will be positioned in middle; other generations on a circle
> pos <- coordinates(NULL,N=NumClass-1)
> pos <- rbind(c(0.5,0.5),pos)
> curves <- DiffMatrix
> curves[] <- -0.4
> curves[1, ] <- 0
> curves[2,1] <- -0.125
> curves[1,2] <- -0.125
> plotmat(main="US population, life cycle, 1966",DiffMatrix,pos=pos,name=names,curve=curves,lcol="darkblue",arr.col="lightblue",
+ box.size=0.07,arr.type="triangle",cex.txt=0.8,box.col="lightyellow",box.prop =1)
> #####
>
> A <- matrix(nrow=7,ncol=7,NA)
> A[,1] <- 1 ; A[1,1]<-0
> pos <- coordinates(NULL,N=6,relsize=0.8) # 6 boxes in circle
> pos <- rbind(c(0.5,0.5),pos) # one in middle
> plotmat(A,pos=pos,lwd=1,curve=0,box.lwd=2,cex.txt=0.8,box.col=2:8,
+ box.cex=0.8,box.size=0.125,arr.length=0.5,box.type=c("multi","rect","ellipse"),
+ shadow.size = 0.01,nr=5,main="plotmat")
> # TRANSITION MATRIX EXAMPLE
> # dataset Teasel
>
> curves <- matrix(nrow=ncol(Teasel),ncol=ncol(Teasel),0)
> curves[3,1]<- curves[1,6]<- -0.35
> curves[4,6]<-curves[6,4]<-curves[5,6]<-curves[6,5]<-0.08
> curves[3,6]<- 0.35
> plotmat(Teasel,pos=c(3,2,1),curve=curves,name=colnames(Teasel),lwd=1,box.lwd=2,cex.txt=0.8,
+ box.cex=0.8,box.size=0.08,arr.length=0.5,box.type="circle",box.prop=1,
+ shadow.size = 0.01,self.cex=0.6,my=-0.075, mx=-0.01,relsize=0.9,
+ self.shiftx=c(0,0,0.125,-0.12,0.125,0),self.shifty=0,main="Teasel population model")
demo(plotweb)
---- ~~~~~~~
> # PLOTWEB examples
> par(ask=TRUE)
> # plotweb examples
> feed <- matrix(nrow=20,ncol=20,1)
> plotweb(feed,legend=FALSE,length=0,main="plotweb")
> feed <- matrix(nrow=20,ncol=20,1)
> diag(feed)<-0
> plotweb(feed,legend=FALSE,main="plotweb")
> feed <- diag(nrow=20,ncol=20,1)
> plotweb(feed,legend=FALSE,main="plotweb")
> plotweb(Rigaweb,main="Gulf of Riga food web",sub="mgC/m3/d",val=TRUE)
> plotweb(Takapotoweb,main="Takapoto atoll planktonic food web",leg.title="mgC/m2/day",lab.size=1)
> plotweb(Takapotoweb,main="Takapoto atoll planktonic food web",sub="mgC/m2/day",lab.size=1,log=TRUE)
sh: 0: Can't open /dev/null
sh: 0: Can't open /dev/null
sh: 1: vi: Permission denied
sh: 0: Can't open /dev/null
diagram documentation built on Oct. 23, 2020, 5:46 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Description Details Author(s) See Also Examples
Description
Visualises simple graphs (networks) based on a transition matrix, utilities to plot flow diagrams, visualising webs,...
Support for the book "A practical guide to ecological modelling - using R as a simulation platform" by Karline Soetaert and Peter M.J. Herman (2009). Springer.
and for the book "Solving Differential Equations in R" by Karline Soetaert, Jeff R. Cash and Francesca Mazzia (in press). Springer.
Details
| Package: | diagram |
| Type: | Package |
| Version: | 1.6 |
| Date: | 2011-06-01 |
| License: | GNU Public License 2 or above |
This package is used in R-package ecolMod, which includes many more examples.
Author(s)
Karline Soetaert (Maintainer)
See Also
plotmat, plotweb, coordinates,
openplotmat,
arrows:
bentarrow,
curvedarrow, segmentarrow,
selfarrow, splitarrow,
straightarrow, treearrow,
boxes and text:
shadowbox, textdiamond,
textellipse, textempty, texthexa,
textdiamond, textplain, textrect,
textround.
electrical networks:
en.Resistor,en.Capacitator,en.Node,
en.Amplifier,en.Signal en.Ground.
Examples
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | ## Not run:
## show examples (see respective help pages for details)
example(plotmat)
example(plotweb)
## run demos
demo("flowchart") # creating flow charts
demo("plotmat") # plotting diagrams inputted as a matrix
demo("plotweb") # plotting webs inputted as a matrix
## open the directory with source code of demos
browseURL(paste(system.file(package="diagram"), "/demo", sep=""))
## show package vignette
vignette("diagram")
edit(vignette("diagram"))
browseURL(paste(system.file(package="diagram"), "/doc", sep=""))
## End(Not run)
|
Example output
Loading required package: shape
plotmt> M <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), name = c("A", "B", "C", "D"),
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8,
plotmt+ box.size = 0.1, box.type = "square", box.prop = 0.5,
plotmt+ main = "plotmat")
plotmt> pp
$arr
[1] row col
<0 rows> (or 0-length row.names)
$comp
x y
[1,] 0.50 0.8333333
[2,] 0.25 0.5000000
[3,] 0.75 0.5000000
[4,] 0.50 0.1666667
$radii
x y
[1,] 0.1 0.05621547
[2,] 0.1 0.05621547
[3,] 0.1 0.05621547
[4,] 0.1 0.05621547
$rect
xleft ybot xright ytop
[1,] 0.40 0.7771179 0.60 0.8895488
[2,] 0.15 0.4437845 0.35 0.5562155
[3,] 0.65 0.4437845 0.85 0.5562155
[4,] 0.40 0.1104512 0.60 0.2228821
plotmt> # when explicitly given, pos should should be inbetween 0, 1
plotmt> pos <- cbind (c(0.2, 0.4, 0.6, 0.8), c(0.8, 0.6, 0.4, 0.2))
plotmt> pp <- plotmat(M, pos = pos, name = c("A", "B", "C", "D"),
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8,
plotmt+ box.size = 0.1, box.type = "square", box.prop = 0.5,
plotmt+ main = "plotmat")
plotmt> # includes arrows between boxes
plotmt> pm <- par(mfrow = c(2, 2))
plotmt> M <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
plotmt> M[2, 1] <- M[3, 1] <- M[4, 2] <- M[4, 3] <- "f1"
plotmt> col <- M
plotmt> col[] <- "red"
plotmt> col[2, 1] <- col[3, 1] <- "blue"
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0, name = 1:4,
plotmt+ lwd = 1, box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, box.type = "circle",
plotmt+ box.prop = 1.0, main = "plotmat")
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0, name = 1:4,
plotmt+ lwd = 1, box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, box.type = "circle",
plotmt+ box.prop = 1.0, arr.len = 0.3,
plotmt+ segment.from = 0.35, segment.to = 0.65)
plotmt> M[1, 2] <- M[1, 3] <- M[2, 4] <- M[3, 4] <- "f2"
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0.1, name = 1:4,
plotmt+ lwd = 1, box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, box.type = "none",
plotmt+ box.prop = 1.0, main = "plotmat", arr.len = 0.2,
plotmt+ segment.from = 0.3, segment.to = 0.7)
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0.1, name = 1:4,
plotmt+ box.lwd = 2, box.cex = 1:4, cex.txt = 0.8,
plotmt+ arr.lcol = col, arr.col = col, arr.pos = 0.7,
plotmt+ arr.type = "simple", lwd = 2, box.type = "none",
plotmt+ box.prop = 1.0, main = "plotmat", arr.len = 0.2,
plotmt+ segment.from = 0.3, segment.to = 0.7)
plotmt> par(mfrow=pm)
plotmt> # self arrows
plotmt> diag(M) <- "self"
plotmt> pp <- plotmat(M, pos = c(2, 2), curve = 0, name = LETTERS[1:4],
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8, self.cex = 0.5,
plotmt+ self.shiftx = c(-0.1, 0.1, -0.1, 0.1),
plotmt+ box.type = "diamond", box.prop = 0.5, main = "plotmat")
plotmt> M <- matrix(nrow = 4, ncol = 4, data = 0)
plotmt> M[2, 1]<- 1 ; M[4, 2] <- 2 ; M[3, 4] <- 3; M[1, 3] <- 4
plotmt> pp <- plotmat(M, pos = c(1, 2, 1), curve = 0.2, name = letters[1:4],
plotmt+ lwd = 1, box.lwd = 2, cex.txt = 0.8, arr.type = "triangle",
plotmt+ box.size = 0.1, box.type = "hexa", box.prop = 0.5,
plotmt+ main = "plotmat")
plotmt> arrlwd <- M*2
plotmt> arr.length <- M*0.4
plotmt> cextxt <- M*0.8
plotmt> plotmat(M, pos = c(1, 2, 1), curve = 0.2, name = letters[1:4], lwd = 1,
plotmt+ box.lwd = 2, arr.type = "triangle", box.size = 0.1,
plotmt+ box.type = "hexa", box.prop = 0.5, main = "plotmat",
plotmt+ arr.lwd = arrlwd, arr.length = arr.length, cex.txt = cextxt)
plotmt> M <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
plotmt> M <- as.data.frame(M)
plotmt> M[[2,1]]<- "k[si]"
plotmt> M[[3,1]]<- "k[N]"
plotmt> M[[4,2]]<- "sqrt(frac(2,3))"
plotmt> names <-
plotmt+ c(expression(lambda[12]), "?",
plotmt+ expression(lambda[13]),expression(lambda[23]))
plotmt> plotmat(M, pos = c(1, 2, 1), name = names, lwd = 1, box.lwd = 2,
plotmt+ curve = 0, cex.txt = 0.8, box.size = 0.1, box.type = "square",
plotmt+ box.prop = 0.5, main = "plotmat")
plotmt> plotmat(M, name = letters[1:4], curve = 0, box.cex = 1:4, box.lwd = 4:1,
plotmt+ box.size = 0.075, arr.pos = 0.7,
plotmt+ box.col = c("lightblue", "green", "yellow", "orange"))
plotwb> plotweb(Rigaweb, main = "Gulf of Riga food web",
plotwb+ sub = "mgC/m3/d", val = TRUE)
plotwb> ArrCol <- Rigaweb
plotwb> ArrCol[] <- "black"
plotwb> ArrCol[,"Sedimentation"] <- "green"
plotwb> plotweb(Rigaweb, main = "Gulf of Riga food web",
plotwb+ sub = "mgC/m3/d", val = FALSE, arr.col = ArrCol)
plotwb> plotweb(diag(20), main = "plotweb")
demo(flowchart)
---- ~~~~~~~~~
> ## Flowchart examples
> par(ask=TRUE)
> ## MODELLING DIAGRAM
> mar <- par(mar=c(1,1,1,1))
> openplotmat(main="from Soetaert and herman, book in prep",cex.main=1)
> elpos<-coordinates (c(1,1,1,1,1,1,1,1),mx=-0.1)
> segmentarrow(elpos[7,],elpos[2,],arr.pos=0.15,dd=0.3,arr.side=3,endhead=TRUE)
> segmentarrow(elpos[7,],elpos[3,],arr.pos=0.15,dd=0.3,arr.side=3,endhead=TRUE)
> segmentarrow(elpos[7,],elpos[4,],arr.pos=0.15,dd=0.3,arr.side=3,endhead=TRUE)
> pin <- par ("pin") # size of plotting region, inches
> xx <- 0.2
> yy <- xx*pin[1]/pin[2]*0.15 # used to make circles round
> sx <- rep(xx,8)
> sx[7] <- 0.05
> sy <- rep(yy,8)
> sy[6] <-yy*1.5
> sy[7] <- sx[7]*pin[1]/pin[2]
> for (i in c(1:7)) straightarrow (to=elpos[i+1,],from=elpos[i,],lwd=2,arr.pos=0.6,endhead=TRUE)
> lab <- c("Problem","Conceptual model","Mathematical model","Parameterisation",
+ "Mathematical solution","","OK?","Prediction, Analysis")
> for (i in c(1:5,8)) textround(elpos[i,],sx[i],sy[i],lab=lab[i])
> textround(elpos[6,],xx,yy*1.5,lab=c("Calibration,sensitivity","Verification,validation"))
> textdiamond(elpos[7,],sx[7],sy[7],lab=lab[7])
> textplain(c(0.7,elpos[2,2]),yy*2,lab=c("main components","relationships"),font=3,adj=c(0,0.5))
> textplain(c(0.7,elpos[3,2]),yy ,"general theory",adj=c(0,0.5),font=3)
> textplain(c(0.7,elpos[4,2]),yy*2,lab=c("literature","measurements"),font=3,adj=c(0,0.5))
> textplain(c(0.7,elpos[6,2]),yy*2,lab=c("field data","lab measurements"),font=3,adj=c(0,0.5))
> #####
> ## DIAGRAM
>
> par(mar=c(1,1,1,1))
> openplotmat()
> elpos<-coordinates (c(1,1,2,4))
> fromto <- matrix(ncol=2,byrow=TRUE,data=c(1,2,2,3,2,4,4,7,4,8))
> nr <-nrow(fromto)
> arrpos <- matrix(ncol=2,nrow=nr)
> for (i in 1:nr)
+ arrpos[i,]<- straightarrow (to=elpos[fromto[i,2],],from=elpos[fromto[i,1],]
+ ,lwd=2,arr.pos=0.6,arr.length=0.5)
> textellipse(elpos[1,],0.1,lab="start",box.col="green",shadow.col="darkgreen",shadow.size=0.005,cex=1.5)
> textrect (elpos[2,],0.15,0.05,lab="found term?",box.col="blue",shadow.col="darkblue",shadow.size=0.005,cex=1.5)
> textrect (elpos[4,],0.15,0.05,lab="related?",box.col="blue",shadow.col="darkblue",shadow.size=0.005,cex=1.5)
> textellipse(elpos[3,],0.1,0.1,lab=c("other","term"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> textellipse(elpos[3,],0.1,0.1,lab=c("other","term"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> textellipse(elpos[7,],0.1,0.1,lab=c("make","a link"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> textellipse(elpos[8,],0.1,0.1,lab=c("new","article"),box.col="orange",shadow.col="red",shadow.size=0.005,cex=1.5)
> dd <- c(0.0,0.025)
> text(arrpos[2,1]+0.05,arrpos[2,2],"yes")
> text(arrpos[3,1]-0.05,arrpos[3,2],"no")
> text(arrpos[4,1]+0.05,arrpos[4,2]+0.05,"yes")
> text(arrpos[5,1]-0.05,arrpos[5,2]+0.05,"no")
> #####
> par(mfrow=c(2,2))
> par(mar=c(0,0,0,0))
> openplotmat()
> elpos<-coordinates (c(2,3))
> treearrow(from=elpos[1:2,],to=elpos[3:5,],arr.side=2,path="H")
> for ( i in 1:5) textrect (elpos[i,],0.15,0.05,lab=i,cex=1.5)
> openplotmat()
> elpos<-coordinates (c(3,2),hor=FALSE)
> treearrow(from=elpos[1:3,],to=elpos[4:5,],arr.side=2,arr.pos=0.2,path="V")
> for ( i in 1:5) textrect (elpos[i,],0.15,0.05,lab=i,cex=1.5)
> openplotmat()
> elpos<-coordinates (c(1,4))
> treearrow(from=elpos[1,],to=elpos[2:5,],arr.side=2,arr.pos=0.7,path="H")
> for ( i in 1:5) textrect (elpos[i,],0.05,0.05,lab=i,cex=1.5)
> openplotmat()
> elpos<-coordinates (c(2,1,2,3))
> elpos[1,1]<-0.3;elpos[2,1]<-0.7
> treearrow(from=elpos[1:3,],to=elpos[4:8,],arr.side=2,path="H")
> for ( i in 1:8) bentarrow(from=elpos[i,],to=elpos[i,]+c(0.1,-0.05),
+ arr.pos=1,arr.type="circle",arr.col="white",arr.length=0.2)
> for ( i in 1:8) textrect (elpos[i,],0.05,0.05,lab=i,cex=1.5)
> mtext(side=3,outer=TRUE,line=-2,"treearrow",cex=1.5)
> par(mfrow=c(1,1))
> par(mar=c(0,0,0,0))
> openplotmat()
> elpos<-coordinates (c(1,1,2,1))
> straightarrow (to=elpos[2,],from=elpos[1,])
> treearrow(from=elpos[2,],to=elpos[3:4,],arr.side=2,path="H")
> treearrow(from=elpos[3:4,],to=elpos[5,],arr.side=2,path="H")
> segmentarrow(from=elpos[5,],to=elpos[2,],dd=0.4)
> curvedarrow(from= elpos[5,],to=elpos[2,],curve=0.8)
> col <- femmecol(5)
> texthexa (mid=elpos[1,],radx=0.1,angle=20,shadow.size=0.01,rady=0.05,lab=1,box.col=col[1])
> textrect (mid=elpos[2,],radx=0.1,shadow.size=0.01,rady=0.05,lab=2,box.col=col[2])
> textround (mid=elpos[3,],radx=0.05,shadow.size=0.01,rady=0.05,lab=3,box.col=col[3])
> textellipse (mid=elpos[4,],radx=0.05,shadow.size=0.01,rady=0.05,lab=4,box.col=col[4])
> textellipse (mid=elpos[5,],radx=0.05,shadow.size=0.01,rady=0.08,angle=45,lab=5,box.col=col[5])
> par(mar=c(1,1,1,1))
> openplotmat(main="Arrowtypes")
> elpos<-coordinates (c(1,2,1),mx=0.1,my=-0.1)
> curvedarrow(from=elpos[1,],to=elpos[2,],curve=-0.5,lty=2,lcol=2)
> straightarrow(from=elpos[1,],to=elpos[2,],lty=3,lcol=3)
> segmentarrow(from=elpos[1,],to=elpos[2,],lty=1,lcol=1)
> treearrow(from=elpos[2:3,],to=elpos[4,],lty=4,lcol=4)
> bentarrow(from=elpos[3,],to=elpos[3,]-c(0.1,0.1),arr.pos=1,lty=5,lcol=5)
> bentarrow(from=elpos[1,],to=elpos[3,],lty=5,lcol=5)
> selfarrow(pos=elpos[3,],path="R",lty=6,curve=0.075,lcol=6)
> splitarrow(from=elpos[1,],to=elpos[2:3,],lty=1,lwd=1,dd=0.7,arr.side=1:2,lcol=7)
> for ( i in 1:4) textrect (elpos[i,],0.05,0.05,lab=i,cex=1.5)
> legend("topright",lty=1:7,legend=c("segmentarrow","curvedarrow","straightarrow",
+ "treearrow","bentarrow","selfarrow","splitarrow"),lwd=c(rep(2,6),1),col=1:7)
> openplotmat(main="textbox shapes")
> rx <- 0.1
> ry <- 0.05
> pos <- coordinates(c(1,1,1,1,1,1,1),mx=-0.2)
> textdiamond(mid=pos[1,],radx=rx,rady=ry,lab=LETTERS[1],cex=2,shadow.col="lightblue")
> textellipse(mid=pos[2,],radx=rx,rady=ry,lab=LETTERS[2],cex=2,shadow.col="blue")
> texthexa(mid=pos[3,],radx=rx,rady=ry,lab=LETTERS[3],cex=2,shadow.col="darkblue")
> textmulti(mid=pos[4,],nr=7,radx=rx,rady=ry,lab=LETTERS[4],cex=2,shadow.col="red")
> textrect(mid=pos[5,],radx=rx,rady=ry,lab=LETTERS[5],cex=2,shadow.col="darkred")
> textround(mid=pos[6,],radx=rx,rady=ry,lab=LETTERS[6],cex=2,shadow.col="black")
> textempty(mid=pos[7,],lab=LETTERS[7],cex=2,box.col="yellow")
> pos[,1] <- pos[,1] + 0.5
> text(pos[,1],pos[,2],c("textdiamond","textellipse","texthexa","textmulti","textrect","textround","textempty"))
> mf<-par(mfrow=c(2,2))
> example(bentarrow)
bntrrw> openplotmat(main = "bentarrow")
bntrrw> pos <- cbind( A <- seq(0.1, 0.9, by = 0.2), rev(A))
bntrrw> text(pos, LETTERS[1:5], cex = 2)
bntrrw> for (i in 1:4)
bntrrw+ bentarrow(from = pos[i,] + c(0.05, 0), to = pos[i+1,] + c(0, 0.05),
bntrrw+ arr.pos = 1, arr.adj = 1)
bntrrw> for (i in 1:2)
bntrrw+ bentarrow(from = pos[i,] + c(0.05, 0), to = pos[i+1, ] + c(0, 0.05),
bntrrw+ arr.pos = 0.5, path = "V", lcol = "lightblue",
bntrrw+ arr.type = "triangle")
bntrrw> bentarrow(from = pos[3, ] + c(0.05, 0), to = pos[4, ] + c(0, 0.05),
bntrrw+ arr.pos = 0.7, arr.side = 1, path = "V", lcol = "darkblue")
bntrrw> bentarrow(from = pos[4, ] + c(0.05, 0), to = pos[5, ] + c(0, 0.05),
bntrrw+ arr.pos = 0.7, arr.side = 1:2, path = "V", lcol = "blue")
> example(coordinates)
crdnts> openplotmat(main = "coordinates")
crdnts> text(coordinates(N = 6), lab = LETTERS[1:6], cex = 2)
crdnts> text(coordinates(N = 8, relsize = 0.5), lab = letters[1:8], cex = 2)
crdnts> openplotmat(main = "coordinates")
crdnts> text(coordinates(pos = c(2, 4, 2)), lab = letters[1:8], cex = 2)
crdnts> plot(0, type = "n", xlim = c(0, 5), ylim = c(2, 8), main = "coordinates")
crdnts> text(coordinates(pos = c(2, 4, 3), hor = FALSE), lab = 1:9, cex = 2)
> par(mfrow=c(2,2))
> example(curvedarrow)
crvdrr> openplotmat(main = "curvedarrow")
crvdrr> pos <- coordinates(pos = 4, my = 0.2)
crvdrr> text(pos, LETTERS[1:4], cex = 2)
crvdrr> for (i in 1:3)
crvdrr+ curvedarrow(from = pos[1, ] + c(0,-0.05), to = pos[i+1, ] + c(0,-0.05),
crvdrr+ curve = 0.5, arr.pos = 1)
crvdrr> for (i in 1:3)
crvdrr+ curvedarrow(from = pos[1, ] + c(0, 0.05), to = pos[i+1, ] + c(0, 0.05),
crvdrr+ curve = -0.25, arr.adj = 1, arr.pos = 0.5,
crvdrr+ arr.type = "triangle", arr.col = "blue")
> example(segmentarrow)
sgmntr> openplotmat(main="segmentarrow")
sgmntr> pos <-cbind(A <- seq(0.2, 0.8, by = 0.2), rev(A))
sgmntr> text(pos, LETTERS[1:4], cex = 2)
sgmntr> segmentarrow(from = pos[1, ] + c(0, 0.05), to = pos[2, ] + c(0, 0.05),
sgmntr+ arr.pos = 1, arr.adj = 1, dd = 0.1,
sgmntr+ path = "UHD", lcol = "darkred")
sgmntr> segmentarrow(from = pos[2, ] + c(-0.05, 0), to = pos[3, ] + c(-0.05, 0.01),
sgmntr+ arr.pos = 1, arr.adj = 1, dd = 0.1,
sgmntr+ lcol = "black", arr.type = "triangle")
sgmntr> segmentarrow(from = pos[2, ] + c(0.05, 0), to = pos[3, ] + c(0.05, 0.01),
sgmntr+ arr.pos = 0.5, dd = 0.3, path = "RVL", arr.side = 1,
sgmntr+ lcol = "lightblue", arr.type = "simple")
sgmntr> segmentarrow(from = pos[3, ] + c(0.05, 0), to = pos[4, ] + c(-0.05, 0.01),
sgmntr+ arr.pos = 0.5, dd = 0.05, path = "RVL", lcol = "darkblue",
sgmntr+ arr.type = "ellipse")
sgmntr> segmentarrow(from = pos[3, ] + c(0, -0.05), to = pos[4, ] + c(0, 0.05),
sgmntr+ arr.pos = 0.5, arr.side = 3, dd = 0.05, path = "DHU",
sgmntr+ lcol = "darkgreen")
sgmntr> segmentarrow(from = pos[3,] + c(-0.05, -0.05), to = pos[4, ] + c(0, -0.05),
sgmntr+ arr.pos = 0.5, arr.side = 1:3, dd = 0.3, path = "DHU",
sgmntr+ lcol = "green")
> example(selfarrow)
slfrrw> openplotmat(main = "selfarrow")
slfrrw> pos <- coordinates(3, mx = 0.05)
slfrrw> text(pos, LETTERS[1:3], cex = 2)
slfrrw> for (i in 1:3)
slfrrw+ selfarrow(pos = pos[i, ], path = "R", arr.pos = 0.2,
slfrrw+ curve = c(0.05, 0.1), lcol = "darkred")
slfrrw> for (i in 1:3)
slfrrw+ selfarrow(pos = pos[i, ], path = "L", arr.pos = 0.7,
slfrrw+ lcol = "darkblue", curve = c(0.05, 0.05))
slfrrw> for (i in 1:3)
slfrrw+ selfarrow(pos = pos[i, ], path = "L", arr.pos = 0.5,
slfrrw+ lcol = "darkgreen", code = i, arr.type = "triangle")
> example(straightarrow)
strght> openplotmat(main = "straightarrow")
strght> pos <- coordinates(c(2, 3, 1))
strght> for (i in 1:5)
strght+ straightarrow(from = pos[i, ], to = pos[i+1, ], arr.pos = 0.5)
strght> straightarrow(from = pos[6, ], to = pos[6, ] + c(0.3, 0.),
strght+ arr.type = "T", arr.pos = 1, arr.lwd = 3)
strght> for (i in 1:6)
strght+ textrect(pos[i, ], lab = LETTERS[i], radx = 0.05)
> par(mfrow=c(2,2))
> example(treearrow)
trerrw> openplotmat(main = "treearrow")
trerrw> pos <- coordinates(c(3, 2, 4, 1))
trerrw> treearrow(from = pos[1:5, ], to = pos[6:10, ])
trerrw> for (i in 1:10)
trerrw+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
trerrw> openplotmat(main = "treearrow")
trerrw> pos <- coordinates(c(2, 4), hor = FALSE)
trerrw> treearrow(from = pos[1:2, ], to = pos[3:6, ],
trerrw+ arr.side = 1:2, path = "V")
trerrw> for (i in 1:6)
trerrw+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
trerrw> openplotmat(main = "treearrow")
trerrw> pos <- coordinates(c(3, 5, 7, 7, 5, 3))
trerrw> treearrow(from = pos[1:15, ], to = pos[15:30, ], arr.side = 0)
trerrw> for (i in 1:30)
trerrw+ textrect(pos[i, ], lab = i, cex = 1.2, radx = 0.025)
> par(mfrow=c(2,2))
> example(splitarrow)
spltrr> openplotmat(main = "splitarrow")
spltrr> pos <- coordinates(c(1, 2, 2, 4, 1))
spltrr> splitarrow(from = pos[1, ], to = pos[2:10, ],
spltrr+ arr.side = 1, centre = c(0.5, 0.625))
spltrr> for (i in 1:10)
spltrr+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
spltrr> openplotmat(main = "splitarrow")
spltrr> pos <- coordinates(c(1, 3))
spltrr> splitarrow(from = pos[1,], to = pos[2:4, ], arr.side = 1)
spltrr> splitarrow(from = pos[1,], to = pos[2:4, ], arr.side = 2)
spltrr> for (i in 1:4)
spltrr+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
spltrr> openplotmat(main = "splitarrow")
spltrr> pos <- coordinates(N = 6)
spltrr> pos <- rbind(c(0.5, 0.5), pos)
spltrr> splitarrow(from = pos[1, ], to = pos[2:7, ], arr.side = 2)
spltrr> for (i in 1:7)
spltrr+ textrect(pos[i, ], lab = i, cex = 2, radx = 0.05)
> par(mfrow=c(2,2))
> example(textdiamond)
txtdmn> openplotmat(xlim = c(-0.1, 1.1), main = "textdiamond")
txtdmn> for (i in 1:10)
txtdmn+ textdiamond(mid = runif(2), col = i, radx = 0.1, rady = 0.05,
txtdmn+ lab = LETTERS[i], cex = 2, angle = runif(1)*360)
> example(textellipse)
txtllp> openplotmat(xlim = c(-0.1, 1.1), main = "textellipse")
txtllp> for (i in 1:10)
txtllp+ textellipse(mid = runif(2), col = i, box.col = grey(0.95),
txtllp+ radx = 0.1, rady = 0.05, lab = LETTERS[i],
txtllp+ cex = 2, angle = runif(1)*360)
> example(textempty)
txtmpt> openplotmat(xlim = c(-0.1, 1.1), col = "lightgrey", main = "textempty")
txtmpt> for (i in 1:10)
txtmpt+ textempty(mid = runif(2), box.col = i, lab = LETTERS[i], cex = 2)
txtmpt> textempty(mid = c(0.5, 0.5), adj = c(0, 0),
txtmpt+ lab = "textempty", box.col = "white")
> example(texthexa)
texthx> openplotmat(xlim = c(-0.1, 1.1), main = "texthexa")
texthx> for (i in 1:20)
texthx+ texthexa(mid = runif(2), angle = runif(1)*360, col = i,
texthx+ box.col = grey(0.95), radx = 0.1, rady = 0.05,
texthx+ lab = LETTERS[i], cex = 2)
> example(textmulti)
txtmlt> openplotmat(xlim = c(-0.1, 1.1), main = "textmulti")
txtmlt> for (i in 1:10)
txtmlt+ textmulti(mid = runif(2), col = i, radx = 0.1, rady = 0.1,
txtmlt+ lab = LETTERS[i], cex = 2, nr = trunc(i/1.5)+3)
> example(textplain)
txtpln> openplotmat(main = "textplain")
txtpln> textplain(mid = c(0.5, 0.5),
txtpln+ lab = c("this text is", "centered", "4 strings", "on 4 lines"))
txtpln> textplain(mid = c(0.5, 0.2), adj = c(0, 0.5), font = 2, height = 0.05,
txtpln+ lab = c("this text is","left alligned"))
txtpln> textplain(mid = c(0.5, 0.8), adj = c(1, 0.5), font = 3, height = 0.05,
txtpln+ lab = c("this text is","right alligned"))
> example(textrect)
txtrct> openplotmat(xlim = c(-0.1, 1.1), main = "textrect")
txtrct> for (i in 1:10)
txtrct+ textrect(mid = runif(2), col = i, radx = 0.1, rady = 0.1,
txtrct+ lab = LETTERS[i], cex = 2)
txtrct> openplotmat(xlim = c(-0.1, 1.1), main = "textparallel")
txtrct> elpos <-coordinates (c(1, 1, 1, 1, 1))
txtrct> textparallel(mid = elpos[1,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=20", theta = 20)
txtrct> textparallel(mid = elpos[2,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=60", theta = 60)
txtrct> textparallel(mid = elpos[3,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=100", theta = 100)
txtrct> textparallel(mid = elpos[4,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=140", theta = 140)
txtrct> textparallel(mid = elpos[5,], col = 1, radx = 0.2, rady = 0.1,
txtrct+ lab = "theta=170", theta = 170)
> example(textround)
txtrnd> openplotmat(xlim = c(-0.1, 1.1), main = "textround")
txtrnd> for (i in 1:10)
txtrnd+ textround(mid = runif(2), col = i,
txtrnd+ radx = 0.03, rady = 0.075,
txtrnd+ lab = LETTERS[i], cex = 2)
> par(mfrow=mf)
demo(plotmat)
---- ~~~~~~~
> ### DEMONSTRATION FOR PLOTMAT
> ## plots diagram based on a matrix
>
>
> ## SIMPLE PLOTMAT example
> par(ask=TRUE)
> par(mar=c(1,1,1,1),mfrow=c(2,2))
> names <- c("A","B","C","D")
> M <- matrix(nrow=4,ncol=4,byrow=TRUE,data=0)
> pp<-plotmat(M,pos=c(1,2,1),name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ box.size=0.1,box.type="square",box.prop=0.5)
> M[2,1]<-M[3,1]<-M[4,2]<-M[4,3] <- "flow"
> pp<-plotmat(M,pos=c(1,2,1),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ box.type="circle",box.prop=1.0)
> diag(M) <- "self"
> pp<-plotmat(M,pos=c(2,2),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ self.cex=0.5,self.shiftx=c(-0.1,0.1,-0.1,0.1),
+ box.type="diamond",box.prop=0.5)
> M <- matrix(nrow=4,ncol=4,data=0)
> M[2,1]<-1 ;M[4,2]<-2;M[3,4]<-3;M[1,3]<-4
> pp<-plotmat(M,pos=c(1,2,1),curve=0.2,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ arr.type="triangle",box.size=0.1,box.type="hexa",box.prop=0.5)
> mtext(outer=TRUE,side=3,line=-1.5,cex=1.5,"plotmat")
> ##PLOTMAT example 2
> names <- c("A","B","C","D")
> M <- matrix(nrow=4,ncol=4,byrow=TRUE,data=0)
> M[2,1]<-M[3,2]<-M[4,3]<-1
> par(mfrow=c(1,2))
> pp<-plotmat(M,pos=c(1,1,1,1),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.,
+ box.size=0.2,box.type="square",box.prop=0.5,arr.type="triangle",
+ arr.pos=0.6)
> p2 <-plotmat(M[1:2,1:2],pos=pp$comp[c(1,4),],curve=0,name=names[c(1,4)],lwd=1,box.lwd=2,
+ cex.txt=0.,box.size=0.2,box.type="square",box.prop=0.5,
+ arr.type="triangle",arr.pos=0.6)
> text(p2$arr$ArrowX+0.1,p2$arr$ArrowY,font=3,adj=0,"one flow")
> par(mfrow=c(1,1))
> mtext(outer=TRUE,side=3,line=-1.5,cex=1.5,"plotmat")
> # Plotmat example NPZZDD model
> names <- c("PHYTO","NH3","ZOO","DETRITUS","BotDET","FISH")
> M <- matrix(nrow=6,ncol=6,byrow=TRUE,data=c(
+ # p n z d b f
+ 0,1,0, 0, 0, 0, #p
+ 0,0,4, 10,11,0, #n
+ 2,0,0, 0, 0, 0, #z
+ 8,0,13,0, 0, 12,#d
+ 9,0,0, 7, 0, 0, #b
+ 0,0,5, 0, 0, 0 #f
+ ))
> pp<-plotmat(M,pos=c(1,2,1,2),curve=0,name=names,lwd=1,box.lwd=2,cex.txt=0.8,
+ box.type="square",box.prop=0.5,arr.type="triangle",
+ arr.pos=0.4,shadow.size=0.01,prefix="f",
+ main="NPZZDD model, from Soetaert and herman, 2009, Springer")
> # extra arrows: flow 5 to Detritus and flow 2 to detritus
> phyto <-pp$comp[names=="PHYTO"]
> zoo <-pp$comp[names=="ZOO"]
> nh3 <-pp$comp[names=="NH3"]
> detritus<-pp$comp[names=="DETRITUS"]
> fish <-pp$comp[names=="FISH"]
> # flow5->detritus
> m2 <- 0.5*(zoo+fish)
> m1 <- detritus
> m1[1]<-m1[1]+ pp$radii[4,1]
> mid<-straightarrow (to=m1,from=m2,arr.type="triangle",arr.pos=0.4,lwd=1)
> text(mid[1],mid[2]+0.03,"f6",cex=0.8)
> # flow2->detritus
> m2 <- 0.5*(zoo+phyto)
> m1 <- detritus
> m1[1] <-m1[1]+ pp$radii[3,1]*0.2
> m1[2]<-m1[2] + pp$radii[3,2]
> mid<-straightarrow (to=m1,from=m2,arr.type="triangle",arr.pos=0.3,lwd=1)
> text(mid[1]-0.01,mid[2]+0.03,"f3",cex=0.8)
> # TRANSITION MATRIX
>
> par(mfrow=c(2,1))
> #labels as formulae
> Numgenerations <- 6
> # Original Population matrix
> DiffMat <- matrix(data=0,nrow=Numgenerations,ncol=Numgenerations) # declare it
> AA <- as.data.frame(DiffMat)
> AA[[1,4]]<- "f[3]"
> AA[[1,5]]<- "f[4]"
> AA[[1,6]]<- "f[5]"
> AA[[2,1]]<- "s[list(0,1)]"
> AA[[3,2]]<- "s[list(1,2)]"
> AA[[4,3]]<- "s[list(2,3)]"
> AA[[5,4]]<- "s[list(3,4)]"
> AA[[6,5]]<- "s[list(4,5)]"
> name <- c("Age0","Age1","Age2","Age3","Age4","Age5")
> PP <- plotmat(A=AA,pos=6,curve=0.7,name=name,lwd=2,arr.len=0.6,arr.width=0.25,my=-0.2,
+ box.size=0.05,arr.type="triangle",dtext= 0.95,cex.txt=0,
+ main="Age-structured population model 1")
> for (i in 1:nrow(PP$arr))
+ text(as.double(PP$arr[i,"TextX"]),as.double(PP$arr[i,"TextY"]),
+ parse(text=as.character(PP$arr[i,"Value"])))
> # reduced population matrix
> Numgenerations <- Numgenerations-1
> DiffMat <- DiffMat[-1,-1]
> AA <- as.data.frame(DiffMat)
> AA[[1,3]]<- "f[3]*s[list(0,1)]"
> AA[[1,4]]<- "f[4]*s[list(0,1)]"
> AA[[1,5]]<- "f[5]*s[list(0,1)]"
> AA[[2,1]]<- "s[list(0,2)]"
> AA[[3,2]]<- "s[list(2,3)]"
> AA[[4,3]]<- "s[list(3,4)]"
> AA[[5,4]]<- "s[list(4,5)]"
> name <- c("Age0","Age2","Age3","Age4","Age5")
> pos <- PP$comp[-1,]
> PP <- plotmat(AA,pos=pos,curve=0.7,name=name,lwd=2,arr.len=0.6,arr.width=0.25,my=-0.1,
+ box.size=0.05,arr.type="triangle",dtext= 0.95,cex.txt=0,main="Age-structured population model 2")
> for (i in 1:nrow(PP$arr))
+ text(as.double(PP$arr[i,"TextX"]),as.double(PP$arr[i,"TextY"]),
+ parse(text=as.character(PP$arr[i,"Value"])))
> par(mfrow=c(1,1),mar=c(2,2,2,2))
> #################3
> par(mfrow=c(1,1))
> par(mar=c(4,4,4,4))
> par(xaxs="r",yaxs="r")
> # Fecundity and Survival for each generation
> NumClass <- 10
> Fecundity <- c(0, 0.00102,0.08515,0.30574,0.40002,
+ 0.28061,0.1526 ,0.0642 ,0.01483,0.00089)
> Survival <- c(0.9967 ,0.99837,0.9978 ,0.99672,0.99607,
+ 0.99472,0.99240,0.98867,0.98274,NA) # survival from i to i+1
> cbind(Fecundity,Survival)
Fecundity Survival
[1,] 0.00000 0.99670
[2,] 0.00102 0.99837
[3,] 0.08515 0.99780
[4,] 0.30574 0.99672
[5,] 0.40002 0.99607
[6,] 0.28061 0.99472
[7,] 0.15260 0.99240
[8,] 0.06420 0.98867
[9,] 0.01483 0.98274
[10,] 0.00089 NA
> # Population matrix M
> DiffMatrix <- matrix(data=0,nrow=NumClass,ncol=NumClass) # declare it
> DiffMatrix[1,] <- Fecundity # first row: fecundity
> for (i in 1:(NumClass-1)) DiffMatrix[i+1,i] <- Survival[i]
> DiffMatrix # print the matrix to screen
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 0.0000 0.00102 0.08515 0.30574 0.40002 0.28061 0.1526 0.06420 0.01483
[2,] 0.9967 0.00000 0.00000 0.00000 0.00000 0.00000 0.0000 0.00000 0.00000
[3,] 0.0000 0.99837 0.00000 0.00000 0.00000 0.00000 0.0000 0.00000 0.00000
[4,] 0.0000 0.00000 0.99780 0.00000 0.00000 0.00000 0.0000 0.00000 0.00000
[5,] 0.0000 0.00000 0.00000 0.99672 0.00000 0.00000 0.0000 0.00000 0.00000
[6,] 0.0000 0.00000 0.00000 0.00000 0.99607 0.00000 0.0000 0.00000 0.00000
[7,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.99472 0.0000 0.00000 0.00000
[8,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.00000 0.9924 0.00000 0.00000
[9,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.00000 0.0000 0.98867 0.00000
[10,] 0.0000 0.00000 0.00000 0.00000 0.00000 0.00000 0.0000 0.00000 0.98274
[,10]
[1,] 0.00089
[2,] 0.00000
[3,] 0.00000
[4,] 0.00000
[5,] 0.00000
[6,] 0.00000
[7,] 0.00000
[8,] 0.00000
[9,] 0.00000
[10,] 0.00000
> names <- c("0-5yr","5-10yr","10-15yr","15-20yr","20-25yr","25-30yr","30-35yr","35-40yr","40-45yr","45-50yr")
> # first generation will be positioned in middle; other generations on a circle
> pos <- coordinates(NULL,N=NumClass-1)
> pos <- rbind(c(0.5,0.5),pos)
> curves <- DiffMatrix
> curves[] <- -0.4
> curves[1, ] <- 0
> curves[2,1] <- -0.125
> curves[1,2] <- -0.125
> plotmat(main="US population, life cycle, 1966",DiffMatrix,pos=pos,name=names,curve=curves,lcol="darkblue",arr.col="lightblue",
+ box.size=0.07,arr.type="triangle",cex.txt=0.8,box.col="lightyellow",box.prop =1)
> #####
>
> A <- matrix(nrow=7,ncol=7,NA)
> A[,1] <- 1 ; A[1,1]<-0
> pos <- coordinates(NULL,N=6,relsize=0.8) # 6 boxes in circle
> pos <- rbind(c(0.5,0.5),pos) # one in middle
> plotmat(A,pos=pos,lwd=1,curve=0,box.lwd=2,cex.txt=0.8,box.col=2:8,
+ box.cex=0.8,box.size=0.125,arr.length=0.5,box.type=c("multi","rect","ellipse"),
+ shadow.size = 0.01,nr=5,main="plotmat")
> # TRANSITION MATRIX EXAMPLE
> # dataset Teasel
>
> curves <- matrix(nrow=ncol(Teasel),ncol=ncol(Teasel),0)
> curves[3,1]<- curves[1,6]<- -0.35
> curves[4,6]<-curves[6,4]<-curves[5,6]<-curves[6,5]<-0.08
> curves[3,6]<- 0.35
> plotmat(Teasel,pos=c(3,2,1),curve=curves,name=colnames(Teasel),lwd=1,box.lwd=2,cex.txt=0.8,
+ box.cex=0.8,box.size=0.08,arr.length=0.5,box.type="circle",box.prop=1,
+ shadow.size = 0.01,self.cex=0.6,my=-0.075, mx=-0.01,relsize=0.9,
+ self.shiftx=c(0,0,0.125,-0.12,0.125,0),self.shifty=0,main="Teasel population model")
demo(plotweb)
---- ~~~~~~~
> # PLOTWEB examples
> par(ask=TRUE)
> # plotweb examples
> feed <- matrix(nrow=20,ncol=20,1)
> plotweb(feed,legend=FALSE,length=0,main="plotweb")
> feed <- matrix(nrow=20,ncol=20,1)
> diag(feed)<-0
> plotweb(feed,legend=FALSE,main="plotweb")
> feed <- diag(nrow=20,ncol=20,1)
> plotweb(feed,legend=FALSE,main="plotweb")
> plotweb(Rigaweb,main="Gulf of Riga food web",sub="mgC/m3/d",val=TRUE)
> plotweb(Takapotoweb,main="Takapoto atoll planktonic food web",leg.title="mgC/m2/day",lab.size=1)
> plotweb(Takapotoweb,main="Takapoto atoll planktonic food web",sub="mgC/m2/day",lab.size=1,log=TRUE)
sh: 0: Can't open /dev/null
sh: 0: Can't open /dev/null
sh: 1: vi: Permission denied
sh: 0: Can't open /dev/null
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.