Nothing
# the interactive plotrix demo
par(ask=FALSE)
answer<-"Z"
whichplot<-"Z"
while(answer != "Q" && whichplot != "X") {
cat("1. Plots B-K\n2. Plots L-Z\n3. Enhancements A-L\n")
cat("4. Enhancements L-V\nQ. Quit\n")
answer<-toupper(readline("Choose a group - "))
if(answer == "Q") break
if(answer=="1") {
cat("1. barNest - Plot nested breakdowns as superimposed bars\n")
cat("2. barp - A bar plotting routine similar to barplot\n")
cat("3. battleship.plot - Plot the values of a matrix as stacked rectangles\n")
cat("4. box.heresy - An unconventional box plot\n")
cat("5. brkdn.plot - Plot aggregate values from groups defines by factors\n")
cat("6. bumpchart - A league table by time plot\n")
cat("7. centipede.plot - A league table (ranking) plot\n")
cat("8. clock24.plot - Plot values on a 24 hour 'clockface'\n")
cat("9. clustered.dotplots - a sort of graphical crosstabulation\n")
cat("A. color2D.matplot - Display a numeric matrix as colors\n")
cat("B. color.scale.lines - Plot lines with colors dependent upon values\n")
cat("C. dendroPlot - Display distributions as dendrites\n")
cat("D. densityGrid - Overlay observation density and intensity on a map\n")
cat("E. diamondplot - Plot variables as polygons on a radial grid\n")
cat("F. dotplot.mtb - Minitab style dotplot\n")
cat("G. ehplot - Englemann-Hecker plot\n")
cat("H. election - Display party affiliations by color\n")
cat("I. fan.plot - Like a pie chart with overlaid sectors\n")
cat("J. feather.plot - Display vectors along a horizontal line\n")
cat("K. floating.pie - Display one or more pie charts\n")
cat("L. gantt.chart - Display a Gantt chart\n")
cat("M. gap.barplot - A bar plot with a specified gap\n")
cat("N. gap.boxplot - A box plot with a specified gap\n")
cat("O. gap.plot - A scatterplot with a specified gap\n")
cat("P. histStack - Display a stacked histogram\n")
cat("Q. intersectDiagram - Display set intersections as rectangles\n")
cat("R. joyPlot - Display a series of density or other curves\n")
cat("S. kiteChart - Display a matrix of values as polygon segments\n")
cat("X. Exit\n")
#par(ask=TRUE)
whichplot<-toupper(readline("Choose a plot - "))
if(whichplot == "1") {
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,ylab="Mean age")
}
if(whichplot == "2") {
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=1,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)
}
if(whichplot == "3") {
x<-matrix(sample(10:50,100,TRUE),10)
xaxlab=c("One","Two","Three","Four","Five","Six","Seven","Eight","Nine","Ten")
yaxlab=c("First","Second","Third","Fourth","Fifth","Sixth","Seventh",
"Eighth","Ninth","Tenth")
battleship.plot(x,xlab="The battle has just begun",main="Battleship1",
xaxlab=xaxlab,yaxlab=yaxlab)
}
if(whichplot == "4") {
y1<-runif(20,2,10)
y2<-rnorm(30,6,2)
y3<-sample(0:20,40,TRUE)
Ns<-c(20,30,40)
ymean<-c(mean(y1),mean(y2),mean(y3))
y1inner<-quantile(y1,probs=c(.16,.84))
y2inner<-c(ymean[2]+sd(y2),ymean[2]-sd(y2))
y3inner<-quantile(y3,probs=c(.16,.84))
uinner<-c(y1inner[1],y2inner[1],y3inner[1])
linner<-c(y1inner[2],y2inner[2],y3inner[2])
ulim<-c(max(y1),max(y2),max(y3))
llim<-c(min(y1),min(y2),min(y3))
box.heresy(ymean,uinner=uinner,linner=linner,ulim=ulim,llim=llim,boxwidth=Ns,
main="Boxplot of means, central spread and range",xlab="Distribution",
xaxlab=c("Uniform","Normal","Sample"))
}
if(whichplot == "5") {
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))
# first use the default values
brkdn.plot("a","c","d",test.df,pch=1:4,col=1:4)
}
if(whichplot == "6") {
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))
par(mar=c(5,5,4,2))
}
if(whichplot == "7") {
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))
}
if(whichplot == "8") {
testlen<-rnorm(24)*2+5
testpos<-0:23+rnorm(24)/4
clock24.plot(testlen,testpos,main="Test Clock24 (lines)",show.grid=FALSE,
line.col="green",lwd=3)
}
if(whichplot == "9") {
data(mtcars)
cumcars<-by(mtcars$carb,list(mtcars$cyl,mtcars$gear),valid.n)
mtcars2<-data.frame(cyl=NA,gear=NA,carb=NA)
rownum<-1
for(cyl in dimnames(cumcars)[[1]]) {
for(gear in dimnames(cumcars)[[2]]) {
if(!is.na(cumcars[cyl,gear])) {
mtcars2[rownum,]<-c(as.numeric(cyl),as.numeric(gear),cumcars[cyl,gear])
rownum<-rownum+1
}
}
}
clustered.dotplots(xgroup = mtcars2$cyl, ygroup = mtcars2$gear,
freq = mtcars2$carb,main="Cars by number of cylinders and gears",
xlab="Number of cylinders",ylab="Number of gears",type="points",pch=5)
}
if(whichplot == "A") {
x<-matrix(rnorm(1024),nrow=32)
# simulate a correlation matrix with values -0.5 to 0.5
x<-rescale(x,c(-0.5,0.5))
# add a column with the extreme values (-1,1) to calculate
# the colors, then drop the extra column in the result
cellcol<-color.scale(cbind(x,c(-1,rep(1,31))),c(0,1),0,c(1,0))[,1:32]
color2D.matplot(x,cellcolors=cellcol,main="Blue to red correlations")
# do the legend call separately to get the full range
color.legend(0,-4,10,-3,legend=c(-1,-0.5,0,0.5,1),
rect.col=color.scale(c(-1,-0.5,0,0.5,1),c(0,1),0,c(1,0)),align="rb")
}
if(whichplot == "B") {
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)
}
if(whichplot == "C") {
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")
}
if(whichplot == "D") {
x<-sample(1:20,400,TRUE)
y<-sample(1:20,400,TRUE)
z<-runif(400,5,20)
xyz<-makeDensityMatrix(x,y,z,nx=20,ny=20,xlim=c(1,10),ylim=c(1,10),
geocoord=FALSE)
par(mar=c(7,3,2,3))
plot(0,xlim=c(1,10),ylim=c(1,10),type="n",xlab="",axes=FALSE)
box()
densityGrid(xyz,range.cex=c(1,4),xlim=c(1,10),ylim=c(1,10),
red=c(0,0.5,0.8,1),green=c(1,0.8,0.5,0),blue=0,pch=15)
color.legend(3,-0.7,7,-0.2,c(5,10,15,20),
rect.col=color.scale(1:4,cs1=c(0,0.5,0.8,1),cs2=c(1,0.8,0.5,0),cs3=0,alpha=1))
par(xpd=TRUE)
text(5,0.3,"Intensity")
points(c(3.5,4.5,5.5,6.5),rep(-1.7,4),pch=15,cex=1:4)
text(c(3.5,4.5,5.5,6.5),rep(-1.3,4),1:4)
text(5,-1,"Density")
par(xpd=FALSE)
}
if(whichplot == "E") {
data(mtcars)
mysubset<-mtcars[substr(dimnames(mtcars)[[1]],1,1)=="M",c("mpg","hp","wt","disp")]
diamondplot(mysubset,name="Diamondplot")
}
if(whichplot == "F") {
x <- rpois(100,10)
dotplot.mtb(x,yaxis=TRUE,main="Minitab dotplot with y-axis.")
}
if(whichplot == "G") {
data(iris)
ehplot(iris$Sepal.Length, iris$Species, intervals=20, cex=1.8, pch=20)
}
if(whichplot == "H") {
eu = structure(list(colour = c("#3399FF", "#F0001C", "#0054A5",
"#FFD700", "#990000", "#909090", "#32CD32", "#40E0D0"),
party = c("EPP", "S and D", "ECR", "ALDE", "GUE-NGL",
"Non-Inscrits", "Greens-EFA", "EFDD"),
members = c(220L, 191L, 70L, 68L, 52L, 52L, 50L, 48L)),
.Names = c("colour", "party", "members"), row.names = c(NA,
-8L), class = "data.frame")
strasbourg = seats(751, 16)
eugov = election(strasbourg, eu, party~members, colours=eu$colour)
oldmar<-par(mar=c(2,4,4,2))
plot(eugov$x, eugov$y, col=eugov$colour, asp=1, pch=19, ylim=c(-2,2.5),
xlab="", ylab="", main="EU Parliament 2014", axes=FALSE)
legend(-0.7,-0.3,eu$party,fill=eu$colour)
par(oldmar)
}
if(whichplot == "I") {
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)
}
if(whichplot == "J") {
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")
}
if(whichplot == "K") {
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"))
}
if(whichplot == "L") {
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)
}
if(whichplot == "M") {
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")
}
if(whichplot == "N") {
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")
}
if(whichplot == "O") {
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)
}
if(whichplot == "P") {
df<-data.frame(len=rnorm(100)+5,
grp=sample(c("A","B","C","D"),100,replace=TRUE))
histStack(len~grp,data=df,main="Default (rainbow) colors",
xlab="Length category")
}
if(whichplot == "Q") {
druguse<-matrix(c(sample(c(0,1),200,TRUE,prob=c(0.15,0.85)),
sample(c(0,1),200,TRUE,prob=c(0.35,0.65)),
sample(c(0,1),200,TRUE,prob=c(0.5,0.5)),
sample(c(0,1),200,TRUE,prob=c(0.9,0.1))),ncol=4)
colnames(druguse)<-c("Alc","Tob","THC","Amp")
druglist<-makeIntersectList(druguse,sep="\n")
# first display it as counts
intersectDiagram(druglist,main="Patterns of drug use",sep="\n")
}
if(whichplot == "R") {
numbmat<-matrix(runif(500,0,1),nrow=10)
denslist<-apply(numbmat,1,density)
names(denslist)<-month.abb[1:10]
joyPlot(denslist,main="Test of joyPlot",fill="lightgray")
}
if(whichplot == "S") {
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),timex=FALSE)
# not enough space for the last label, add it
mtext("Sine",at=65,side=1,line=2)
}
if(whichplot=="X") break
}
if(answer == "2") {
cat("1. labbePlot - Display a L'Abbe plot - successes as sizes of circles\n")
cat("2. ladderplot - Plot 1D scatterplots with connecting lines\n")
cat("3. multhist - Histogram for multiple series\n")
cat("4. oz.windrose - Australian Bureau of Meteorology wind rose\n")
cat("5. panes - Prepare a 'panel' type plot\n")
cat("6. perspx - Perspective plot\n")
cat("7. pie3D - 3D pie chart\n")
cat("8. plotH - Scatterplot with histogram-like bars\n")
cat("9. polar.plot - Plot values on a 360 degree chart\n")
cat("A. pyramid.plot - Pyramid plot\n")
cat("B. radial.pie - Plot sectors/annuli on a circular grid\n")
cat("C. radial.plot - Plot values on a 0 to 2*pi grid\n")
cat("D. raw.means.plot - Plot for experimental designs\n")
cat("E. sizeplot - Plot with repeated symbols by size\n")
cat("F. sizetree - Categorical breakdown as stacked rectangles\n")
cat("G. size_n_color - Display circles with specified size and color\n")
cat("H. stackpoly - Like a line plot with fill under the lines\n")
cat("I. staircase.plot - Display a staircase plot\n")
cat("J. taylor.diagram - Display a Taylor diagram\n")
cat("K. triax.plot - Triangle (three axis) plot\n")
cat("L. twoord.plot - Plot with two ordinates\n")
cat("M. vectorField - Diaplay magnitude/direction vectors\n")
cat("N. violin_plot - Display a violin plot\n")
cat("O. weighted.hist - Display a weighted histogram\n")
cat("P. zoomInPlot - Display a plot with a magnified section\n")
cat("X. Exit\n")
whichplot<-toupper(readline("Choose a plot - "))
if(whichplot == "1") {
didf<-data.frame(subject=1:50,interv=rep(c("therapist","ex-drinker"),each=25),
outcome=sample(c("more","less"),50,TRUE))
# make it into a table
didf.tab<-table(didf$interv,didf$outcome)
# now mix in some raw percentages just for the example
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)
labbePlot(list(c(20,40,20)),col=list("purple"),labels=list("Z"),add=TRUE)
}
if(whichplot == "2") {
x<-data.frame(A=c(1:10), B=c(2:11)+rnorm(10))
y<-data.frame(x, C=c(1:10)+rnorm(10))
ladderplot(x)
}
if(whichplot == "3") {
l<-list(runif(10)*10,1:10,c(1,1,1,1,4,8))
multhist(l)
}
if(whichplot == "4") {
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)
}
if(whichplot == "5") {
y<-runif(8)
oldpar<-panes(matrix(1:4,nrow=2,byrow=TRUE))
par(mar=c(0,2,1.6,0))
boxplot(y,axes=FALSE)
axis(2)
box()
par(mar=c(0,0,1.6,2))
tab.title("Boxplot of y",tab.col="#88dd88")
barplot(y,axes=FALSE,col=2:9)
axis(4)
box()
tab.title("Barplot of y",tab.col="#88dd88")
par(mar=c(2,2,1.6,0))
pie(y,col=2:9)
tab.title("Pie chart of y",tab.col="#88dd88")
box()
par(mar=c(2,0,1.6,2))
plot(y,xaxs="i",xlim=c(0,9),axes=FALSE,col=2:9)
axis(4)
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(mfrow=c(1,1))
}
if(whichplot == "6") {
x <- 1:10
y <- 1:10
z <- outer(x,y,function(x,y) { 3*sin(2*pi*x)/(2*pi*x)+exp(y/10)+(x*y)/1000 })
par(mar=c(5,10,2,2))
pp <- perspx(x,y,z,ticktype="detailed",phi=30,theta=80,nticks=3,r=10,
axes=FALSE)
par(mar=c(5,4,4,2))
}
if(whichplot == "7") {
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")
# grab the radial positions of the labels
lp<-pie3D(pieval,radius=0.9,labels=pielabels,explode=0.1,
main="3D PIE OPINIONS")
par(mar=c(5,4,4,2))
}
if(whichplot == "8") {
d<-data.frame(x=c(1,5,10:20),y=runif(13)+1,
g=factor(sample(c("A","B","C"),13,replace=TRUE)))
# new plotH function with formula notation
plotH(y~x,data=d)
}
if(whichplot == "9") {
testlen<-c(rnorm(36)*2+5)
testpos<-seq(0,350,by=10)
polar.plot(testlen,testpos,main="Test Polar Plot",lwd=3,line.col=4)
}
if(whichplot == "A") {
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))
}
if(whichplot == "B") {
pie1<-c(3,6,5,4,7,8,9,1,4)
pie2<-list(0:3,1:6,2:5,1:4,0:7,4:8,2:9,0:1,0:4)
pie3<-sample(10:60,36)
pie4<-list(sort(sample(1:60,8)))
for(sector in 2:36) pie4[[sector]]<-sort(sample(1:60,8))
par(radial.pie(pie1,labels=LETTERS[1:9]))
}
if(whichplot == "C") {
testlen<-runif(10,0,10)
testpos<-seq(0,18*pi/10,length=10)
testlab<-letters[1:10]
par(radial.plot(testlen,testpos,main="Test Radial Lines",line.col="red",
lwd=3,rad.col="lightblue"))
}
if(whichplot == "D") {
x <- data.frame(id = 1:150,
offset = rep(c("Group A", "Group B", "Group C"),
each = 50), xaxis = sample(c("A", "B", "C", "D"),150, replace = TRUE),
data = c(rnorm(50, 10, 5), rnorm(50, 15,6), rnorm(50, 20, 5)))
raw.means.plot(x)
}
if(whichplot == "E") {
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)
}
if(whichplot == "F") {
cat1<-factor(sample(c("None","Low","Medium","High","Extreme"),40,TRUE),
levels=c("None","Low","Medium","High","Extreme"))
cat2<-factor(sample(c("None","Low","Medium","High"),40,TRUE),
levels=c("None","Low","Medium","High"))
cat3<-factor(sample(c("None","Low","High"),40,TRUE),
levels=c("None","Low","High"))
hcats<-data.frame(cat1,cat2,cat3)
# throw in a few NAs
hcats$cat1[10]<-NA
hcats$cat2[c(15,20)]<-NA
hcats$cat3[c(11,14,25)]<-NA
# first let sizetree work out the colors
sizetree(hcats,main="Sizetree with automatic colors")
par(mar=c(5,4,4,2))
}
if(whichplot == "G") {
meantemp<-c(19,22,25,29,21,20,16,27,23,26)
totalrain<-c(174,152,196,120,177,183,92,153,161,85)
numpumpkin<-c(53,47,61,63,38,42,48,71,66,29)
meanwt<-c(1.5,2.3,2.8,1.9,2.4,1.8,2.6,2.2,1.7)
size_n_color(meantemp,totalrain,meanwt/5,NA,xlim=c(15,30),
color.scale(numpumpkin,c(0.8,0),c(0.8,1),0),
xlab="Temperature (degrees C)",ylab="Rainfall (mm)",
main="Number and weight of pumpkins by temperature and rainfall",
xat=seq(15,30,by=5),yat=seq(80,200,by=20))
color.legend(15,55,18.5,60,seq(40,70,by=10),
rect.col=color.scale(seq(40,70,by=10),c(0.8,0),c(0.8,1),0))
points(15:18,rep(126,4),cex=seq(1.5,3.0,by=0.5))
text(15:19,rep(134,5),c("1.5","2.0","2.5","3.0","kg"))
par(xpd=TRUE)
text(13.5,60,"Number of\npumpkins")
par(xpd=FALSE)
}
if(whichplot == "H") {
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)
}
if(whichplot == "I") {
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")
}
if(whichplot == "J") {
ref<-rnorm(30,sd=2)
model1<-ref+rnorm(30)/2
model2<-ref+rnorm(30)
oldpar<-taylor.diagram(ref,model1)
taylor.diagram(ref,model2,add=TRUE,col="blue")
lpos<-1.5*sd(ref)
legend(lpos,lpos,legend=c("Better","Worse"),pch=19,col=c("red","blue"))
par(oldpar)
}
if(whichplot == "K") {
data(soils)
triax.plot(soils[1:10,],main="DEFAULT")
}
if(whichplot == "L") {
going_up<-seq(3,7,by=0.5)+rnorm(9)
going_down<-rev(60:74)+rnorm(15)
twoord.plot(2:10,going_up,1:15,going_down,xlab="Sequence",
ylab="Ascending values",rylab="Descending values",lcol=4,
main="Plot with two ordinates - points and lines",
do.first="plot_bg();grid(col=\"white\",lty=1)")
}
if(whichplot == "M") {
plot(1:10,type="n",main="Random vectors")
mag<-runif(100)+1
dir<-runif(100)*2*pi
xpos<-rep(1:10,10)
ypos<-rep(1:10,each=10)
vectorcol<-sample(colors(),100)
vectorField(dir,mag,xpos,ypos,scale=0.8,vecspec="rad",col=vectorcol)
}
if(whichplot == "N") {
normvar<-c(rnorm(49),-4)
unifvar<-runif(50,-2,2)
violin_plot(matrix(c(normvar,unifvar),ncol=2),
main="Default plot",x_axis_labels=c("Normal","Uniform"))
}
if(whichplot == "O") {
testx<-sample(1:10,300,TRUE)
testw<-seq(1,4,by=0.01)
weighted.hist(testx,testw,breaks=1:10,main="Test weighted histogram")
}
if(whichplot == "P") {
zoomInPlot(rnorm(100),rnorm(100),rxlim=c(-1,1),rylim=c(-1,1),
zoomtitle="Zoom In Plot",titlepos=-1.5)
}
if(whichplot=="X") break
}
if(answer=="3") {
cat("1. ablineclip - add a line to a plot clipped to a specified rectangle\n")
cat("2. addtable2plot - Add a table of values to a plot\n")
cat("3. arctext - Display text on a circular arc\n")
cat("4. axis.break - Add a 'break' mark to an axis\n")
cat("5. axis.mult - Display an axis with a multiplier value\n")
cat("6. barlabels - Add bar labels to a bar plot\n")
cat("7. boxed.labels - Add labels with optional boxes around them\n")
cat("8. clean.args - Remove inappropriate arguments from a list\n")
cat("9. color.id - identify closest match to a named color\n")
cat("A. color.legend - Legend matching categories or values to colors\n")
cat("B. color.scale - Turn values into colors\n")
cat("C. corner.label - Find the corners of the plot and display a label\n")
cat("D. cylindrect - Display an apparent cylinder\n")
cat("E. dispersion - Display error bars or confidence bands\n")
cat("F. draw.(arc|circle|line) - display a graphic element on a plot\n")
cat("G. emptyspace/MaxEmptyRect - Find the largest empty space on a plot\n")
cat("H. fullaxis - Display an axis that extends the full width/height\n")
cat("I. getFigCtr - Get the coordinates of the center of the current figure\n")
cat("J. getMarginWidth - Calculate the margin needed for text or a legend\n")
cat("K. getYmult - Calculate the ratio of y values to x values\n")
cat("L. gradient.rect - Display a rectangle with shaded colors\n")
cat("M. hexagon - Draw a hexagon on the current plot\n")
cat("N. jiggle - Move points apart, a bit like jitter\n")
cat("O. legendg - Display a grouped legend\n")
cat("P. length.key - Key for interpreting lengths in a plot\n")
cat("X. Exit\n")
whichplot<-toupper(readline("Choose an enhancement - "))
if(whichplot == "1") {
x <- rnorm(100)
y <- x + rnorm(100)
lmfit <- lm(y~x)
plot(x, y, xlim=c(-3.5, 3.5))
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")
}
if(whichplot == "2") {
testdf <- data.frame(Before = c(10, 7, 5, 9), During = c(8, 6, 2, 5),
After = c(5, 3, 4, 3))
rownames(testdf) <- c("Red", "Green", "Blue", "Lightblue")
barp(testdf, main = "Test addtable2plot", ylab = "Value",
names.arg = colnames(testdf), col = 2:5)
}
if(whichplot == "3") {
plot(0, xlim = c(1, 5),ylim = c(1, 5),main = "Test of 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)
arctext("bendy like spaghetti", center = c(3, 3), radius = 1.7,
start = 4 * pi / 3, cex = 1.3, clockwise = FALSE)
}
if(whichplot == "4") {
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")
}
if(whichplot == "5") {
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)
}
if(whichplot == "6") {
heights<-c(14,20,9,31,17)
barpos<-barplot(heights,main="A redundant bar plot")
# show the usual value labels on the bars
barlabels(barpos,heights)
}
if(whichplot == "7") {
x<-rnorm(10)
y<-rnorm(10)
plot(x,y,type="p")
nums<-c("one","two","three","four","five","six",
"seven","eight","nine","ten")
boxed.labels(x,y-0.1,nums)
}
if(whichplot == "8") {
tststr <- list(n=2,mean=0,sd=1,foo=4,bar=6)
clean.args(tststr,rnorm)
try(do.call("rnorm",tststr))
do.call("rnorm",clean.args(tststr,rnorm))
remove.args(tststr,rnorm)
}
if(whichplot == "9") {
cat("Color ID -",color.id("#cc00cc"),"\n")
}
if(whichplot == "A") {
# get some extra room
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")
# this will put the labels at the intersections
# col.labels<-c("","Cold","","Warm","","Warmer","","Hot","")
color2D.matplot(matrix(rnorm(100),nrow=10),c(1,0),0,c(0,1),
main="Test color legends")
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))
}
if(whichplot == "B") {
x<-rnorm(20)
y<-rnorm(20)
plot(x,y,col=color.scale(y,c(0,1,1),c(1,1,0),0),main="Color scale plot",
pch=16,cex=2)
plot(1:10,rep(1:3,length.out=10),axes=FALSE,type="n",xlim=c(0,11),ylim=c(0,4),
main="Test of RGB, HSV and HCL",xlab="",ylab="Color specification")
axis(2,at=1:3,labels=c("HCL","HSV","RGB"))
points(1:10,rep(1,10),pch=19,cex=8,col=color.scale(1:10,c(0,300),35,85,
color.spec="hcl"))
points(1:10,rep(2,10),pch=19,cex=8,col=color.scale(1:10,c(0,1),
0.8,1,color.spec="hsv"))
points(1:10,rep(3,10),pch=19,cex=8,col=color.scale(1:10,c(1,0.5,0),
c(0,0.5,0),c(0,0,1),color.spec="rgb"))
}
if(whichplot == "C") {
plot(1:10,1:10)
corner.label("A")
corner.label(x=1,y=1)
corner.label("B",y=-1,x=1,figcorner=TRUE,col="red")
}
if(whichplot == "D") {
plot(0,xlim=c(0,5),ylim=c(0,5),main="Examples of pseudocylindrical rectangles",
xlab="",ylab="",axes=FALSE,type="n")
cylindrect(0,0,1,5,"red")
cylindrect(rep(1,3),c(0,2,4),rep(4,3),c(1,3,5),"green",gradient="y")
cylindrect(4,0,5,5,"#8844aa")
}
if(whichplot == "E") {
disptest<-matrix(rnorm(200),nrow=20)
disptest.means<-rowMeans(disptest)
row.order<-order(disptest.means)
se.disptest<-unlist(apply(disptest,1,std.error))
plot(disptest.means[row.order],main="Dispersion as error bars",
ylim=c(min(disptest.means-se.disptest),max(disptest.means+se.disptest)),
xlab="Occasion",ylab="Value")
dispersion(1:20,disptest.means[row.order],se.disptest[row.order])
}
if(whichplot == "F") {
plot(0,xlim=c(0,10),ylim=c(0,10),type="n")
draw.arc(5,5,4,deg1=0,deg2=180,col="blue",lwd=3)
draw.circle(5,5,3,lwd=3,col="red")
draw.ellipse(5,5,2.5,1.5,col="green",lwd=3)
draw.radial.line(3,4,center=c(5,5),deg=270,lwd=3,col="brown")
}
if(whichplot == "G") {
x<-runif(100)
y<-runif(100)
plot(x,y,main="Find the maximum empty rectangle",xlab="X",ylab="Y")
mer<-maxEmptyRect(c(0,1),c(0,1),x,y)
rect(mer$rect[1],mer$rect[2],mer$rect[3],mer$rect[4],border="red")
es<-emptyspace(x,y)
boxed.labels(es,labels="Here is the\nempty space",bg="transparent")
}
if(whichplot == "H") {
plot(runif(20,-1,1),runif(20,-1,1),xlim=c(-1,1.5),main="Demo of fullaxis",
xlab="X",ylab="Y",axes=FALSE)
fullaxis(1,col="red",col.axis="red")
fullaxis(2,col="blue",col.axis="blue")
fullaxis(4,at=c(-0.5,0,0.5),labels=c("Negative","Zero","Positive"),pos=1.2,
col="green",las=1)
xylim<-par("usr")
segments(xylim[1],xylim[4],xylim[2],xylim[4])
}
if(whichplot == "I") {
plot(1:10)
getFigCtr()
}
if(whichplot == "J") {
plot(rnorm(10))
newmarinfo<-getMarginWidth(labels=c("Long label","Even longer label"))
oldmar<-par("mar")
par(mar=c(oldmar[1:3],newmarinfo$newmar))
plot(rnorm(10))
par(xpd=TRUE)
text(rep(newmarinfo$marcenter,2),c(0.5,-0.5),
c("Long label","Even longer label"))
par(mar=oldmar,xpd=FALSE)
}
if(whichplot == "K") {
plot(1:3,c(10,20,30))
getYmult()
}
if(whichplot == "L") {
plot(0:10,type="n",axes=FALSE)
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)
}
if(whichplot == "M") {
plot(1:3,type="n")
hexagon(1.5,1.5,col="green")
}
if(whichplot == "N") {
ahw.df<-data.frame(Age=rnorm(100,35,10),
Height=rnorm(100,160,15),Weight=rnorm(100,75,20))
par(mfrow=c(1,3))
boxplot(ahw.df$Age,main="Age")
points(jiggle(100,c(0.5,1.5)),ahw.df$Age,col="red")
boxplot(ahw.df$Height,main="Height")
points(jiggle(100,c(0.5,1.5)),ahw.df$Height,col="green")
boxplot(ahw.df$Weight,main="Weight")
points(jiggle(100,c(0.5,1.5)),ahw.df$Weight,col="blue")
par(mfrow=c(1,1))
}
if(whichplot == "O") {
plot(0.5,0.5,xlim=c(0,1),ylim=c(0,1),type="n",
main="Test of grouped legend function")
legendg(0.5,0.8,c("one","two","three"),pch=list(1,2:3,4:6),
col=list(1,2:3,4:6),pt.space=1.5)
legendg(0.5,0.5,c("one","two","three"),fill=list(1,2:3,4:6))
}
if(whichplot == "P") {
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")
vectorField(o,m,vecspec="rad")
lengthKey(0.3,-0.5,c(0,5,10),0.24)
}
if(whichplot=="X") break
}
if(answer == "4") {
cat("1. multsymbolbox - Draw boxes filled with symbols\n")
cat("2. oz.windrose.legend - Draw a legend for oz.windrose\n")
cat("3. p2p_arrows - Draw arrows between specified points\n")
cat("4. pie.labels - Display labels on a pie chart\n")
cat("5. placeLabels - manually place labels on a plot\n")
cat("6. plot_bg - Add a background color to a plot\n")
cat("7. polygon.shadow - Display a shadow effect\n")
cat("8. print.brklist - Print the list generated by brkdnNest\n")
cat("9. propbrk - Calculate the proportion of a specified value\n")
cat("A. rectFill - Display rectangle(s) filled with symbols\n")
cat("B. rescale - Rescale a vector of numbers into a new range\n")
cat("C. Plot with one or both x and y axes reversed\n")
cat("D. ruginv - Add an inverse rug axis to a plot\n")
cat("E. smoothColors - Build a vector of interpolated colors\n")
cat("F. spread.labels - Spread out labels for clustered values\n")
cat("G. spreadout - Spread out a vector of numbers to a minimum spacing\n")
cat("H. starPie - A polygonal graphic object almost unlike a pie chart\n")
cat("I. staxlab - Stagger or rotate axis labels\n")
cat("J. tab.title - Display a plot title in a colored tab\n")
cat("K. thigmophobe.labels - Place labels away from the nearest point\n")
cat("L. triax.abline - Display a line on a triangle plot\n")
cat("M. triax.fill - Color the triangles on a triangle plot\n")
cat("N. tsxpos - Calculated equispaced x positions of plotted values\n")
cat("O. valid.n - Find the number of valid (not NA) values\n")
cat("X. Exit\n")
whichplot<-toupper(readline("Choose an enhancement - "))
if(whichplot == "1") {
plot(1:10,1:10,type="n")
multsymbolbox(c(2,4),5,c(4,5),8,tot=c(10,8))
}
if(whichplot == "2") {
plot(0,xlim=c(-20,20),ylim=c(-20,20),type="n",axes=FALSE,xlab="",ylab="")
par(xpd=TRUE)
oz.windrose.legend()
par(xpd=FALSE)
}
if(whichplot == "3") {
plot(1:2)
points(2:1)
p2p_arrows(c(1,2),c(1,1),c(2,1),c(2,2),code=3)
}
if(whichplot == "4") {
pieval<-c(2,1,3,94)
plot(1:5,type="n",axes=FALSE,xlab="",ylab="")
box()
bisect.angles<-floating.pie(3,3,pieval)
pie.labels(3,3,bisect.angles,c("two","one","three","ninety\nfour"))
}
if(whichplot == "5") {
x<-rnorm(3)
y<-rnorm(3)
cat("Click where the labels are to be placed\n")
plot(x,y)
placeLabels(x,y,LETTERS[1:3],flagcol="purple")
}
if(whichplot == "6") {
barp(1:5,do.first="plot_bg()",col=1:5)
}
if(whichplot == "7") {
par(pty="s")
plot(1:5,type="n",main="Polygon Shadow test",xlab="",ylab="",axes=FALSE)
box()
polygon(c(1,2.2,2.2,1),c(5,5,3.8,3.8),col="#ffff00")
polygon.shadow(c(1.2,2,2,1.2),c(4.8,4.8,4,4),col=c("#ffff00","#cccc00"))
polygon(c(1.2,2,2,1.2),c(4.8,4.8,4,4),col=c("#ff0000"))
polygon(c(4,5,5,4),c(2,2,1,1),col="#aaaaff")
polygon.shadow(c(4.5,4.8,4.2),c(1.7,1.2,1.2),col=c("#aaaaff","#8888cc"),
offset=c(0.1,-0.1),inflate=c(0.2,0.2))
polygon(c(4.5,4.8,4.2),c(1.7,1.2,1.2),col=c("#00ff00"))
polygon.shadow(cos(seq(0,2*pi,by=pi/20))+3,sin(seq(0,2*pi,by=pi/20))+3,
offset=c(0,0),inflate=c(0.1,0.1))
text(3,3,"Polygon shadow\nas a circular\ntext background",cex=1.5)
}
if(whichplot == "8") {
printbrktest<-data.frame(A=c(sample(1:10,99,TRUE),NA),
B=sample(c("Yes","No"),100,TRUE),
C=sample(LETTERS[1:3],100,TRUE))
pbt<-brkdnNest(A~B+C,printbrktest)
print(pbt)
}
if(whichplot == "9") {
cat("Proportion of M -",propbrk(sample(LETTERS,100,TRUE),trueval="M"))
}
if(whichplot == "A") {
plot(1:7,type="n",xlab="",ylab="",main="Test of rectFill")
rectFill(1:6,1:6,2:7,2:7,bg=2:7,pch=c("+","*","o",".","#","^"),
xinc=c(0.2,0.1,0.2,0.1,0.2,0.2),yinc=c(0.2,0.1,0.2,0.1,0.2,0.2),
pch.col=1:6)
}
if(whichplot == "B") {
normal.counts<-rnorm(100)
normal.tab<-tabulate(cut(normal.counts,breaks=seq(-3,3,by=1)))
normal.density<-rescale(dnorm(seq(-3,3,length=100)),range(normal.tab))
plot(c(-2.5,-1.5,-0.5,0.5,1.5,2.5),normal.tab,xlab="X values",
type="h",col="green")
lines(seq(-3,3,length=100),normal.density,col="blue")
}
if(whichplot == "C") {
x <- runif(20)
y <- runif(20)
revaxis(x,y,yside=4)
}
if(whichplot == "D") {
require(stats)
plot(density(faithful$eruptions,bw=0.15))
ruginv(faithful$eruptions,ticksize=-0.05)
ruginv(jitter(faithful$eruptions,amount=0.01),side=3,col="lightblue")
}
if(whichplot == "E") {
plot(1:10,main="Test opaque colors",type="n",axes=FALSE)
box()
rect(1:7,1:7,3:9,3:9,col=smoothColors("red",2,"green",2,"blue"))
}
if(whichplot == "F") {
x<-sort(rnorm(10))
y<-rnorm(10)/10
plot(x,y,ylim=c(-1,1),type="p")
nums<-c("one","two","three","four","five","six","seven","eight","nine","ten")
spread.labels(x,y,nums)
}
if(whichplot == "G") {
cat("Spread out values -",spreadout(c(5,2.5,2.5,NA,3.5,1,3.5,NA),0.2),"\n")
}
if(whichplot == "H") {
date_mat<-data.frame(sex=rep(c("M","F"),each=10),
names=c("Abe","Bob","Col","Dave","Eddie","Frank","Geoff","Harry","Igor","Jack",
"Alice","Betty","Clare","Dora","Eva","Fran","Grace","Hilda","Iris","Joan"),
eating=sample(0:100,20),dancing=sample(0:100,20),movies=sample(0:100,20),
reading=sample(0:100,20),travel=sample(0:100,20))
plot(0,xlim=c(0.5,10.5),ylim=c(0,3),type="n",axes=FALSE,xlab="",ylab="Sex",
main="Date matching matrix")
par(xpd=TRUE)
legend(0.7,-0.3,c("Eat out","Dance","Movies","Read","Travel"),fill=rainbow(5),
ncol=5)
par(xpd=FALSE)
box()
axis(2,at=c(0.9,2.4),labels=c("Male","Female"))
starPie(x=rep(1:10,2),y=rep(c(0.9,2.4),each=10),radext=0.5,
values=as.matrix(date_mat[,3:7]),label=as.character(date_mat[["names"]]))
}
if(whichplot == "I") {
x<-rnorm(12)
plot(x,axes=FALSE)
box()
months<-c("January","February","March","April","May","June",
"July","August","September","October","November","December")
staxlab(1,1:12,months)
}
if(whichplot == "J") {
testx<-matrix(cumsum(rnorm(30)^2)+1,nrow=10)
stackpoly(testx,main="",
xaxlab=c("One","Two","Three","Four","Five",
"Six","Seven","Eight","Nine","Ten"),staxx=TRUE)
tab.title("Three Squiggly Lines",tab.col="yellow",radius=0.5)
}
if(whichplot == "K") {
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),font=2)
}
if(whichplot == "L") {
oldpar<-par()
triax.plot(data.frame(bottom=0.4,right=0.3,left=0.3),
main="Triax ablines",no.add=FALSE)
triax.abline(l=0.3,col="red")
triax.abline(r=0.3,col="green")
triax.abline(b=0.4,col="blue")
par(oldpar)
}
if(whichplot == "M") {
oldpar<-par()
fillval<-list(0,c(0,0.1,0),c(0,0.1,0.2,0.1,0),
c(0,0.1,0.2,0.3,0.2,0.1,0),c(0,0.1,0.2,0.3,0.4,0.3,0.2,0.1,0),
c(0,0.1,0.2,0.3,0.4,0.5,0.4,0.3,0.2,0.1,0),
c(0,0,0.1,0.2,0.3,0.4,0.5,0.4,0.3,0.2,0.1,0,0),
c(0,0,0,0.1,0.1,0.2,0.3,0.4,0.3,0.2,0.1,0.1,0,0,0))
fillcol<-sapply(fillval,function(x) {x*10+1} )
triax.plot(main="Test of triax.fill function")
triax.fill(fillcol)
par(oldpar)
}
if(whichplot == "N") {
y<-rnorm(28)
par(mfrow=c(2,1))
plot(y,main="Plot of the values")
yt<-ts(y,start=2011,frequency=12)
plot(yt,main="Plot of the time series",xaxt="n",xlab="Month")
labelpos<-tsxpos(yt)
staxlab(1,labelpos,rep(month.abb,length.out=28))
par(mfrow=c(1,1))
}
if(whichplot == "O") {
cat("Valid n =",valid.n(c(1,2,3,NA,5,6,7,NA,9,10)),"\n")
}
if(whichplot=="X") break
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.