# The plotrix demo in roughly alphabetical order
# Press <Enter> to advance through the demo,
# Ctrl-C (Linux) or Esc (Windows) to exit
par(ask=TRUE)
x <- rnorm(100)
y <- x + rnorm(100)
lmfit <- lm(y~x)
plot(x,y,xlim=c(-3.5,3.5),main="Ablineclip")
ablineclip(lmfit,x1=-2,x2=2,lty=2)
ablineclip(h=0,x1=-2,x2=2,lty=3,col="red")
ablineclip(v=0,y1=-2.5,y2=1.5,lty=4,col="green")
testdf<-data.frame(Before=c(10,7,5),During=c(8,6,2),After=c(5,3,4))
rownames(testdf)<-c("Red","Green","Blue")
barp(testdf,main="Test addtable2plot",ylab="Value",
 names.arg=colnames(testdf),col=2:4)
addtable2plot(2,8,testdf,bty="o",display.rownames=TRUE,hlines=TRUE,
 title="The table")
plot(0,xlim=c(1,5),ylim=c(1,5),main="Arctext",xlab="",ylab="",
 type="n")
arctext("bendy like spaghetti",center=c(3,3),col="blue")
arctext("bendy like spaghetti",center=c(3,3),radius=1.5,start=pi,cex=2)
arctext("bendy like spaghetti",center=c(3,3),radius=0.5,
 start=pi/2,stretch=1.2)
plot(3:10,main="Axis break test")
# put a break at the default axis and position
axis.break()
axis.break(2,2.9,style="zigzag")
twogrp<-c(rnorm(10)+4,rnorm(10)+20)
gap.plot(twogrp,gap=c(8,16),xlab="Index",ylab="Group values",
 main="Two separated groups with gap axis break",
 col=c(rep(2,10),rep(3,10)),ytics=c(3,5,18,20))
legend(12,6,c("Low group","High group"),pch=1,col=2:3)
plot(1:10*0.001,1:10*100,axes=FALSE,xlab="",ylab="",main="Axis multipliers")
box()
axis.mult(1,mult=0.001)
axis.mult(2,mult=100)
par(mar=c(5,5,4,2))
test.df<-data.frame(Age=rnorm(100,25,10),
 Sex=sample(c("M","F"),100,TRUE),
 Marital=sample(c("M","X","S","W"),100,TRUE),
 Employ=sample(c("FT","PT","NO"),100,TRUE))
test.col<-list(Overall="green",Employ=c("purple","orange","brown"),
 Marital=c("#1affd8","#caeecc","#f7b3cc","#94ebff"),Sex=c(2,4))
barNest(formula=Age~Employ+Marital+Sex,data=test.df,main="barNest",
 col=test.col,showall=TRUE)
happyday<-data.frame(Monday=c(2.3,3.4),Tuesday=c(2.8,3.3),Wednesday=c(3.2,3.1),
Thursday=c(3.6,2.8),Friday=c(4.2,2.6),Saturday=c(4.5,2.9),Sunday=c(4.1,2.8))
happylabels<-c("Utterly dashed","Rather mopey","Indifferent","Somewhat elated",
 "Euphoric")
barp(happyday,names.arg=names(happyday),legend.lab=c("Slaves","Unemployed"),
 legend.pos=list(x=2,y=4.5),col=c("#ee7700","#3333ff"),
 main="Test of barp, staxlab and color.legend",
 xlab="Day of week",ylab="Happiness rating",ylim=c(1,5),staxx=TRUE,staxy=TRUE,
 height.at=1:5,height.lab=happylabels,cex.axis=0.9,cylindrical=TRUE,
 shadow=TRUE)
par(mar=c(5,4,4,2))
h1<-table(cut(rnorm(100,4),breaks=seq(0,8,by=2)))
h2<-table(cut(rnorm(100,4),breaks=seq(0,8,by=2)))
h3<-table(cut(rnorm(100,4),breaks=seq(0,8,by=2)))
hmat<-matrix(c(h1,h2,h3),nrow=3,byrow=TRUE)
barp(hmat,names.arg=names(h1),width=0.45,col=2:4,
 main="Multiple histogram using barp",xlab="Bins",ylab="Frequency")
legend(3.8,50,c("h1","h2","h3"),fill=2:4)
x<-rnorm(10)
y<-rnorm(10)
plot(x,y,type="p",main="Boxed.labels")
nums<-c("one","two","three","four","five","six","seven","eight","nine","ten")
boxed.labels(x,y-0.1,nums)
test.df<-data.frame(a=rnorm(80)+4,b=rnorm(80)+4,c=rep(LETTERS[1:4],each=20),
 d=rep(rep(letters[1:4],each=4),5))
bp<-brkdn.plot("a","c","d",test.df,main="Test of brkdn.plot",
 mct="median",md="mad",xlab="Temperature range", ylab="Cognition",
 xaxlab=c("10-15","16-20","21-25","25-30"),pch=1:4,lty=1:4,col=1:4,ylim=c(0,6))
legend(1,2.5,legend=c("Sydney","Gosford","Karuah","Brisbane"),pch=1:4,
 col=1:4,lty=1:4,xjust=0.5,yjust=0.5)
educattn<-matrix(c(90.4,90.3,75.7,78.9,66,71.8,70.5,70.4,68.4,67.9,
 67.2,76.1,68.1,74.7,68.5,72.4,64.3,71.2,73.1,77.8),ncol=2,byrow=TRUE)
rownames(educattn)<-c("Anchorage AK","Boston MA","Chicago IL",
 "Houston TX","Los Angeles CA","Louisville KY","New Orleans LA",
 "New York NY","Philadelphia PA","Washington DC")
colnames(educattn)<-c(1990,2000)
bumpchart(educattn,rank=FALSE,
 main="Percentage high school completion by over 25s",col=rainbow(10))
# margins have been reset, so use
par(xpd=TRUE)
boxed.labels(1.5,seq(65,90,by=5),seq(65,90,by=5))
par(xpd=FALSE)
testcp<-list("",40)
for(i in 1:40) testcp[[i]]<-rnorm(sample(1:8,1)*50)
segs<-get.segs(testcp)
centipede.plot(segs,main="Centipede plot",vgrid=0)
xy.mat<-cbind(sample(1:10,200,TRUE),sample(1:10,200,TRUE))
clusteredpoints<-
 cluster.overplot(xy.mat,col=rep(c("red","green"),each=100))
plot(clusteredpoints,col=clusteredpoints$col,
 main="Cluster overplot test")
xy.mat<-cbind(sample(1:10,200,TRUE),sample(1:10,200,TRUE))
count.overplot(xy.mat,main="Count overplot test",
 xlab="X values",ylab="Y values")
 par(mar=c(7,4,4,6))
testcol<-color.gradient(c(0,1),0,c(1,0),nslices=5)
col.labels<-c("Cold","Warm","Hot")
color2D.matplot(matrix(rnorm(100),nrow=10),c(1,0),0,c(0,1),
 main="Test color2D.matplot with color.legend")
color.legend(11,6,11.8,9,col.labels,testcol,gradient="y")
color.legend(10.2,2,11,5,col.labels,testcol,align="rb",gradient="y")
color.legend(0.5,-2,3.5,-1.2,col.labels,testcol)
color.legend(7,-1.8,10,-1,col.labels,testcol,align="rb",col=testcol[c(1,3,5)])
par(mar=c(5,4,4,2))
x<-c(0,cumsum(rnorm(99)))
y<-c(0,cumsum(rnorm(99)))
xydist<-sqrt(x*x+y*y)
plot(x,y,main="Random walk plot (color.scale.lines)",xlab="X",ylab="Y",type="n")
color.scale.lines(x,y,c(1,1,0),0,c(0,1,1),colvar=xydist,lwd=2)
boxed.labels(x,y,labels=1:100,border=FALSE,cex=0.5)
testlen<-rnorm(24)*2+5
testpos<-0:23+rnorm(24)/4
clock24.plot(testlen[7:19],testpos[7:19],
 main="Test Clock24 daytime (symbols)",
 point.col="blue",rp.type="s",lwd=3)
par(mar=c(5,4,4,2))
x<-seq(1,100)
y<-sin(x/5)+x/20
clplot(x,y,main="Clplot")
x<-list(runif(90,1,2),factor(sample(LETTERS,100,TRUE)),rnorm(80,mean=5))
dendroPlot(x,breaks=list(seq(1,2,by=0.1),0,0:10),nudge=c(0.03,0.3),
 xlab="Groups",ylab="Counts",main="Test dendroPlot")
data(mtcars)
mysubset<-mtcars[substr(dimnames(mtcars)[[1]],1,1)=="M",c("mpg","hp","wt","disp")]
diamondplot(mysubset,name="Diamondplot")
plot(1:10, asp = 1,main="Test draw.arc")
draw.arc(5, 5, 1:10/10, deg2 = 1:10*10, col = "blue")
draw.arc(8, 8, 1:10/10, deg2 = 1:10*10, col = 1:10)
plot(1:5,seq(1,10,length=5),type="n",xlab="",ylab="",main="Test draw.circle")
draw.circle(2,4,c(1,0.66,0.33),border="purple",
 col=c("#ff00ff","#ff77ff","#ffccff"),lty=1,lwd=1)
draw.circle(2.5,8,0.6,border="red",lty=3,lwd=3)
draw.circle(4,3,0.7,border="green",lty=1,lwd=1)
draw.circle(3.5,7,0.8,border="blue",lty=2,lwd=2)
x<-rnorm(10)
y<-rnorm(10)
plot(x,y,main="Find the empty space",xlab="X",ylab="Y")
es<-emptyspace(x,y)
boxed.labels(es,labels="Here is the\nempty space")
iucn.df<-data.frame(area=c("Africa","Asia","Europe","N&C America",
 "S America","Oceania"),threatened=c(5994,7737,1987,4716,5097,2093))
fan.plot(iucn.df$threatened,max.span=pi,
 labels=paste(iucn.df$area,iucn.df$threatened,sep="-"),
 main="Threatened species by geographical area (fan.plot)",ticks=276)
feather.plot(0.6+rnorm(8)/5,seq(0,7*pi/4,by=pi/4),1:8,
 main="Test of feather.plot",xlab="Time",ylab="Value")
plot(1:5,type="n",main="Floating Pie test",xlab="",ylab="",axes=FALSE)
box()
polygon(c(0,0,5.5,5.5),c(0,3,3,0),border="#44aaff",col="#44aaff")
floating.pie(1.7,3,c(2,4,4,2,8),radius=0.5,
 col=c("#ff0000","#80ff00","#00ffff","#44bbff","#8000ff"))
floating.pie(3.1,3,c(1,4,5,2,8),radius=0.5,
 col=c("#ff0000","#80ff00","#00ffff","#44bbff","#8000ff"))
floating.pie(4,1.5,c(3,4,6,7),radius=0.5,
 col=c("#ff0066","#00cc88","#44bbff","#8000ff"))
draw.circle(3.9,2.1,radius=0.04,col="white")
draw.circle(3.9,2.1,radius=0.04,col="white")
draw.circle(3.9,2.1,radius=0.04,col="white")
draw.circle(4,2.3,radius=0.04,col="white")
draw.circle(4.07,2.55,radius=0.04,col="white")
draw.circle(4.03,2.85,radius=0.04,col="white")
text(c(1.7,3.1,4),c(3.7,3.7,3.7),c("Pass","Pass","Fail"))
Ymd.format<-"%Y/%m/%d"
gantt.info<-list(labels=
 c("First task","Second task","Third task","Fourth task","Fifth task"),
 starts=
 as.POSIXct(strptime(
 c("2004/01/01","2004/02/02","2004/03/03","2004/05/05","2004/09/09"),
 format=Ymd.format)),
 ends=
 as.POSIXct(strptime(
 c("2004/03/03","2004/05/05","2004/05/05","2004/08/08","2004/12/12"),
 format=Ymd.format)),
 priorities=c(1,2,3,4,5))
vgridpos<-as.POSIXct(strptime(c("2004/01/01","2004/02/01","2004/03/01",
 "2004/04/01","2004/05/01","2004/06/01","2004/07/01","2004/08/01",
 "2004/09/01","2004/10/01","2004/11/01","2004/12/01"),format=Ymd.format))
vgridlab<-
 c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
gantt.chart(gantt.info,main="Calendar date Gantt chart (2004)",
 priority.legend=TRUE,vgridpos=vgridpos,vgridlab=vgridlab,hgrid=TRUE)
twogrp<-c(rnorm(10)+4,rnorm(10)+20)
gap.barplot(twogrp,gap=c(8,16),xlab="Index",ytics=c(3,6,17,20),
 ylab="Group values",main="gap.barplot")
twovec<-list(vec1=c(rnorm(30),-6),vec2=c(sample(1:10,40,TRUE),20))
gap.boxplot(twovec,gap=list(top=c(12,18),bottom=c(-5,-3)),
 main="Test gap.boxplot")
twogrp<-c(rnorm(5)+4,rnorm(5)+20,rnorm(5)+5,rnorm(5)+22)
gpcol<-c(2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5,5,5,5,5)
gap.plot(twogrp,gap=c(8,16),xlab="Index",ylab="Group values",
 main="Test gap.plot",col=gpcol)
plot(0:10,type="n",axes=FALSE,main="gradient.rect")
gradient.rect(1,0,3,6,reds=c(1,0),
 greens=c(seq(0,1,length=10),seq(1,0,length=10)),
 blues=c(0,1),gradient="y")
gradient.rect(4,0,6,6,c(seq(0,1,length=10),rep(1,10)),
 c(rep(1,10),seq(1,0,length=10)),c(0,0),gradient="y")
gradient.rect(7,0,9,6,col=smoothColors("red",38,"blue"),border=NA)
druguse<-matrix(c(sample(c(0,1),200,TRUE),
 sample(c(0,1),200,TRUE),
 sample(c(0,1),200,TRUE),
 sample(c(0,1),200,TRUE)),ncol=4)
colnames(druguse)<-c("Alc","Tob","THC","Amp")
druglist<-makeIntersectList(druguse)
intersectDiagram(druglist)
testmat<-matrix(c(runif(50),sample(1:50,50),rnorm(50)+5,
 sin(1:50)),ncol=50,byrow=TRUE)
kiteChart(testmat,varlabels=c("Uniform","Sample","Normal","Sine"),
 timepos=seq(1:50,by=5))
didf<-data.frame(subject=1:50,interv=rep(c("therapist","ex-drinker"),each=25),
 outcome=sample(c("more","less"),50,TRUE))
didf.tab<-table(didf$interv,didf$outcome)
didf2<-c(74,46,200)
didf3<-c(33,87,500)
x<-list(didf.tab,didf2,didf3)
labbecol<-list("red","green","blue")
labbePlot(x,main="Ex-drinkers vs therapists",
 xlab="Percent reduced drinking (ex-drinkers)",
 ylab="Percent reduced drinking (therapists)",
 labels=list("A","B52","X117"),col=labbecol)
l <- list(runif(10)*10,1:10,c(1,1,1,1,4,8))
multhist(l,main="Test of multhist")
windagg<-matrix(c(8,0,0,0,0,0,0,0,4,6,2,1,6,3,0,4,2,8,5,3,5,2,1,1,
 5,5,2,4,1,4,1,2,1,2,4,0,3,1,3,1),nrow=5,byrow=TRUE)
oz.windrose(windagg,legend.pos=-26,main="Australian BoM wind rose")
y<-runif(8)
oldpar<-panes()
boxplot(y,axes=FALSE)
box()
tab.title("Boxplot of y",tab.col="#88dd88")
barplot(y,axes=FALSE,col=2:9)
box()
tab.title("Barplot of y",tab.col="#88dd88")
pie(y,col=2:9)
tab.title("Pie chart of y",tab.col="#88dd88")
box()
plot(y,xaxs="i",xlim=c(0,9),axes=FALSE,col=2:9)
box()
tab.title("Scatterplot of y",tab.col="#88dd88")
# center the title at the left edge of the last plot
mtext("Test of panes function",at=0,side=1,line=0.8,cex=1.5)
par(oldpar)
pieval<-c(2,4,6,8)
pielabels<-
 c("We hate\n pies","We oppose\n  pies","We don't\n  care","We just love pies")
pie3D(pieval,radius=0.9,labels=pielabels,explode=0.1,main="3D PIE OPINIONS")
sex<-sample(c("M","F"),100,TRUE)
hair<-sample(c("Blond","Black","Brown","Red"),100,TRUE)
eye<-sample(c("Blue","Black","Brown","Green"),100,TRUE)
charac<-data.frame(sex=sex,hair=hair,eye=eye)
characlist<-makeDendrite(charac)
plot.dendrite(characlist,names(charac),
 main="Dendrogram of sex, hair and eye color",cex=0.8)
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,
 1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,
 1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
 "35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
 "75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
 main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,
 gap=0.5,show.values=TRUE))
posmat<-matrix(sample(2:9,30,TRUE),nrow=3)
radial.plot(posmat,labels=paste("X",1:10,sep=""),rp.type="p",
 main="Spiderweb plot (radial.plot)",line.col=2:4,show.grid=FALSE,lwd=1:3,
 radial.lim=c(0,10))
x <- runif(20)
y <- runif(20)
revaxis(x,y,yside=4,main="Test revaxis")
x <- c(0.1,0.1,0.1,0.1,0.1,0.2,0.2,0.2,0.2,0.3,0.3)
y <- c( 1,  1,  1,  1,  2,  2,  2,  3,  3,  4,  5 )
plot(x,y)
sizeplot(x,y,main="sizeplot")
cat1<-sample(c("None","Low","Medium","High"),40,TRUE)
cat2<-sample(c("None","Low","Medium","High"),40,TRUE)
cat3<-sample(c("None","Low","Medium","High"),40,TRUE)
hcats<-data.frame(cat1,cat2,cat3)
bhcol<-list(c("#ff8080","#dddd80","#80ff80","#8080ff"),
 c("red","green","lightblue","yellow"),
 c("#ffffff","#bbbbbb","#999999","#666666"))
sizetree(hcats,col=bhcol,main="sizetree (hierarchical count chart)")
soils.sw.percent<-data.frame(
 Sand=c(67,67,66,67,36,25,24,59,27,9,8,8,20,
 45,50,56,34,29,39,41,94,98,97,93,96,99),
 Silt=c(17,16,9,8,39,48,54,27,46,70,68,68,66,
 34,30,24,48,53,46,48,2,2,2,4,1,1),
 Clay=c(16,17,25,25,25,27,22,14,27,21,24,24,
 14,21,20,20,18,18,15,11,4,0,1,3,3,0))
soils.sw.cols <- c(1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3,
 3, 3, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6)
soils.sw.names <- c("Ardington","Astrop","Atrim",
 "Banbury","Beacon","Beckfoot")
soil.texture.uk(soils.sw.percent,
 main = "Ternary Diagram for Some Soils from South West England",
 col.lines = "black", col.names = "black", show.grid = TRUE,
 col.grid = "blue", lty.grid = 2,  pch = 16, cex = 1.0,
 col.symbols = soils.sw.cols, h1 = NA, h3 = NA, t1 = NA,
 t3 = NA , lwduk = 2, xpos = NA, ypos = NA,
 snames = NA, cexuk = 1.1)
legend("topleft", legend = soils.sw.names, col = 1:max(soils.sw.cols),
 pch = 16, cex = 1.1, title = "Location", bty = "n")
fpkids<-data.frame(Food=c("Fatty/sugary","Fruit","Starchy","Meat",
 "Proc.meat","Eggs","Fish","Dairy","Vegetables"),
 Female=c(4.21,4.22,3.98,3.57,3.55,3.46,3.34,3.26,3.13),
 Male=c(4.35,4.13,4.02,3.9,3.81,3.64,3.45,3.27,2.96))
plot(rep(1,9),fpkids$Female,xlim=c(0.8,2.2),
 ylim=range(c(fpkids$Female,fpkids$Male)),xlab="Sex",xaxt="n",
 ylab="Mean preference rating",main="Children's food preferences by sex",
 col="red")
axis(1,at=1:2,labels=c("Female","Male"))
points(rep(2,9),fpkids$Male,col="blue",pch=2)
spread.labels(rep(1:2,each=9),c(fpkids$Female,fpkids$Male),
 fpkids$Food,between=TRUE,linecol=c("red","blue"))
testx<-matrix(abs(rnorm(100)),nrow=10)
stackpoly(matrix(cumsum(testx),nrow=10),main="Test Stackpoly I",
 xaxlab=c("One","Two","Three","Four","Five",
 "Six","Seven","Eight","Nine","Ten"),border="black",staxx=TRUE)
sample_size<-c(500,-72,428,-94,334,-45,289)
totals<-c(TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
labels<-c("Contact list","Uncontactable","","Declined","","Ineligible",
 "Final sample")
staircase.plot(sample_size,totals,labels,
 main="Acquisition of the sample (staircase.plot)",
 total.col="gray",inc.col=2:4,bg.col="#eeeebb",direction="s")
x<-rnorm(20)
y<-rnorm(20)
xlim<-range(x)
xspace<-(xlim[2]-xlim[1])/20
xlim<-c(xlim[1]-xspace,xlim[2]+xspace)
ylim<-range(y)
yspace<-(ylim[2]-ylim[1])/20
ylim<-c(ylim[1]-yspace,ylim[2]+yspace)
plotlabels<-
 c("one","two","three","four","five","six","seven","eight","nine","ten",
 "eleven","twelve","thirteen","fourteen","fifteen","sixteen","seventeen",
 "eighteen","nineteen","twenty")
plot(x=x,y=y,xlim=xlim,ylim=ylim,main="Test thigmophobe.labels")
thigmophobe.labels(x,y,plotlabels,col=c(2:6,8:12))
data(soils)
triax.retval<-triax.plot(soils[1:6,],main="Test triax.plot",
 show.grid=TRUE,show.legend=TRUE,col.symbols=1:6,pch=4)
par(triax.retval$oldpar)
twoord.plot(2:10,seq(3,7,by=0.5)+rnorm(9),
 1:15,rev(60:74)+rnorm(15),xlab="Sequence",
 ylab="Ascending values",rylab="Descending values")
tab.title("Test of twoord.plot and tab.title",tab.col="yellow",radius=0.5)
o<-matrix(rep(pi*seq(0.1,0.8,by=0.1),7),ncol=8,byrow=TRUE)
m<-matrix(rnorm(56)+4,ncol=8,byrow=TRUE)
plot(0,xlim=c(0.7,8.3),ylim=c(0.7,7.3),type="n",
 main="Test vector.field with lengthKey")
vectorField(o,m,vecspec="rad")
lengthKey(0.3,-0.5,c(0,5,10),0.24)
zoomInPlot(rnorm(100),rnorm(100),rxlim=c(-1,1),rylim=c(-1,1),
 zoomtitle="Zoom In Plot",titlepos=-1.5)
readline("End of demo, press <Enter>")
par(ask=FALSE)
dev.off()