plotrix/ 0000755 0001762 0000144 00000000000 14116113662 011754 5 ustar ligges users plotrix/NAMESPACE 0000644 0001762 0000144 00000006207 14011145766 013204 0 ustar ligges users # created 5/9/2011 - Jim Lemon
importFrom("grDevices", "boxplot.stats", "col2rgb", "colors",
"dev.cur", "dev.list", "dev.size", "gray", "heat.colors",
"palette", "rainbow", "rgb", "trans3d", "xy.coords")
importFrom("graphics", "abline", "arrows", "axTicks", "axis",
"axis.POSIXct", "barplot", "barplot.default", "box",
"boxplot", "clip", "hist", "hist.default", "layout",
"legend", "lines", "locator", "matplot", "mtext", "par",
"persp", "plot", "plot.new", "plot.window", "points",
"polygon", "rect", "segments", "strheight",
"strwidth", "symbols", "text", "title", "xinch", "yinch")
importFrom("stats", "aggregate", "approx", "as.formula",
"complete.cases", "cor", "density", "dist", "model.frame",
"na.omit", "bw.nrd0", "qnorm", "rnorm", "sd", "t.test", "terms")
importFrom("utils", "combn", "modifyList")
export(
ablineclip,
addtable2plot,
add.ps,
arctext,
axis.break,
axis.mult,
barlabels,
barNest,
barp,
battleship.plot,
bin.wind.records,
binciW,
binciWl,
binciWu,
box.heresy,
boxed.labels,
brkdn.plot,
brkdnNest,
bumpchart,
categoryReshape,
centipede.plot,
clean.args,
clock24.plot,
clplot,
cluster.overplot,
clustered.dotplots,
color.axis,
color.gradient,
color.id,
color.legend,
color.scale,
color.scale.lines,
color2D.matplot,
corner.label,
count.overplot,
cylindrect,
dendroPlot,
densityGrid,
diamondplot,
dispersion,
dotplot.mtb,
draw.arc,
draw.circle,
draw.ellipse,
draw.radial.line,
draw.tilted.sector,
drawNestedBars,
drawSectorAnnulus,
ehplot,
election,
emptyspace,
fan.plot,
feather.plot,
fill.corner,
find_max_cell,
floating.pie,
fullaxis,
gantt.chart,
gap_barp,
gap.barplot,
gap.boxplot,
gap.plot,
get.breaks,
get.gantt.info,
get.segs,
get.soil.texture,
get.tablepos,
get.triprop,
getFigCtr,
getIntersectList,
getMarginWidth,
getYmult,
gradient.rect,
hexagon,
histStack,
intersectDiagram,
jiggle,
joyPlot,
kiteChart,
labbePlot,
ladderplot,
ladderplot.default,
legendg,
lengthKey,
makeDensityMatrix,
makeIntersectList,
maxEmptyRect,
mtext3d,
multhist,
multivari,
multsymbolbox,
oz.windrose,
oz.windrose.legend,
p2p_arrows,
panes,
pasteCols,
paxis3d,
perspx,
pie.labels,
pie3D,
pie3D.labels,
placeLabels,
plot_bg,
plotCI,
plotH,
polar.plot,
polygon.shadow,
propbrk,
psegments3d,
ptext3d,
pyramid.plot,
radial.grid,
radial.pie,
radial.plot,
radial.plot.labels,
radialtext,
raw.means.plot,
raw.means.plot2,
rectFill,
remove.args,
rescale,
revaxis,
ruginv,
seats,
size_n_color,
sizeplot,
sizetree,
sliceArray,
smoothColors,
soil.texture,
soil.texture.uk,
spread.labels,
spreadout,
stackpoly,
staircase.plot,
staircasePlot,
starPie,
staxlab,
std.error,
sumbrk,
symbolbarplot,
symbolbox,
tab.title,
taylor.diagram,
textbox,
thigmophobe,
thigmophobe.labels,
triax.abline,
triax.fill,
triax.frame,
triax.plot,
triax.points,
tsxpos,
twoord.plot,
twoord.stackplot,
valid.n,
vectorField,
violin_plot,
weighted.hist,
zoomInPlot
)
# methods
S3method(print,brklist)
S3method(histStack,default)
S3method(histStack,formula)
S3method(plotH,formula)
S3method(plotH,default)
S3method(ladderplot,default)
plotrix/demo/ 0000755 0001762 0000144 00000000000 14011145766 012704 5 ustar ligges users plotrix/demo/plotrix.R 0000755 0001762 0000144 00000114454 14011145766 014544 0 ustar ligges users # 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
}
}
plotrix/demo/00Index 0000644 0001762 0000144 00000000060 14011145766 014032 0 ustar ligges users plotrix Interactive demo of plotrix functions
plotrix/data/ 0000755 0001762 0000144 00000000000 14011145766 012671 5 ustar ligges users plotrix/data/death_reg.rda 0000644 0001762 0000144 00000002207 14011145766 015304 0 ustar ligges users XRFV 3$N&ڒ Ka0M/S%L.C ^lKH2S5_y<@}NuRd&gF||g=Ҟ=Z'aԅoOoo*s&ҍ(RD.5MU1m4Mp-$C,pcu e>8 -Ϗ s0?boc}χfcr]!s k.o8
# T?'25 ) ?z2 xiN'pڗcOXe|xؗMos2} - _˶3 WıBaՄK696S\
O>5G'x[[=_ p R%pok".lܓ2Q
{b]|p|gBOSlHP;2]y
[Zc&d8 S2Fi\&$GS(J\\qd!W-
P^^bN *WێSsItn-z#Ckdk
J~WήKQ2/-~VB?$Tm߮]Ah ؽKZ}Y+$];jZ:HFtL~XfLܒt9ſ
$^+s=ϩl|/'{7R"^%^; P h\YΥUکMv
ܼxZds=ǯUӺ* Ҽ $sgN -Ua}iK~ ~Weoi:Fy7( KenU[>_AnGO B+i~mgz"(K@c8'} ޱy]$'"n 7(8q'}
5 Dgל|lpK(^ 6u4w uj x*n 0f{!:)G
璆{ϥzooG,Rq#(꿀_k5Uk,cX>c.OPu}WAqg_c/y,{0o߉<<9 0;NFy[nsWH R/AK"ѸqlB_T^9DW,/T.ějMz_y8EqUqT+㼪8 k! Yz⍣_HCh]/8>P-ۍ~+KӔGul=$b-#| 벨נ ζ s 콐%e 㭨[s &8>xۨ2ïҦϿ5HGPC3 ;Jy6^F|'sCr 8[ן
bk K̯?{jާ7#Q_1Ov?߇{ ST?pPGȻq|- 7qs : OR?T%RGowְ) 7& _/.|??0NzB 6= }{
x/qnsY晸OR4Ҧ8K? ~k+c s] -p 6v;67h{{COy/tV VLV,VlV V\VJ}|կWd孛𐐬 uAJjG8sfͯ_? 9v8ϐ D ? ̵pl ,"gB&gwE [}dV1CŅnEswxOQ&K0/eIFù3B*?["{'5u4"XXЪDJftPN{
o4Cb\K3>6f#=o3kc+2x t2 h":#|T!֣fBZ nz uҔtpNz[lVa{`y'fwx5g//(䙛2&ZΨ6h*/S4?u2+*SG? ~r$AcE)\8-|y m(Pu\oh ))~ (i J2qeV#-4CON*t;;:)R2"Og-zʙJ]0d2.%/ nI"I}AHUyĘNu'_!C(MpHepA4W dEKO+ht
Cv?DCg ֊<'GA>m !쮣D`ރCp4^3O^3ѵսPW}]LhfIl23B|sSka@{黃ʻ|=/߰rax-U7 NzE{ϯ;`GcE>,Ko!lh[AxϨ?|zQQ
w@p瓐GnΖiA8+cV8cm~ՍV GRU 4vt
[d}h.K/BT"B $m@&0ilޣ8H5JKL CV>a R$[uփ Ћ] S#S%xXvn ĵev
RuAw?rT_ ,G[@XJ{Lnzlێknh?uzΌ[ (;X9K
%~xץZЧ$H60݅: Qs4VtGm~hR#6!ht>c{Ϸ7ԉ&+F~69\r H) aj
'yAԏXi]E*[ | !Ep< >=hrWkK_M ~ӓ?"SJгGAQ5n0w^VO-gOM>Sde1>>w.ȷټBOْ8fA{gސ g ;r2*S&W\+OmonHܶy44N+ ڛ9Uh7>S1ߩ=N&C)x겸>L8Vo{F~+bzx'þSS'"Q4ߎ&e 'gѦ'4
b+.#ch*IO|w\AB#]:$ADjLbhk
ba61{@lϫUt3م%_uOG :FNVQʍȳ]}FNLv1z1~ؕɲ
1N2TX YF>.!g[(a(A5 (4Vm"1+A՟ȷ盇Nә\~] * /шu. }g|wc.a&c88Uc;Z/ώ{֤pauM[}!oxīyo[aר_FTN8=n]//gZη- p~#Ӕepg6 C_͠mb'n,EyU=2 kN-_UJgu3AH$yR_WuGZCoĐ'Z},!j{BTW?_
4EA9$YF>e/ έT/╠ 'n6ɇC(4o=
V_tAk}ݺVhH*sy}z(S [FV\z&Ve
n˧ZϏiOq ;Hk̶^7Ϙ:X.좕L 캮_˄עaRpC-Tɭ u/QӉf%0
osAΆtC)c7tC^Ԣ]h=nrwW"7PF'2 ؟XC
{,Kվg97ڢ;U
aApv\Yy ඨ ț'3n& *e.nEVMw>p9.o7>wW"THƎk0fz8|9ݷmAR_r @<,[KԯoqI&ۿki8
ۧ68~!I"BVy=
'P 1N,q۽
q0Ҹ#Qo*q0. (+#\/h2ly dnT}9>c 0& jo^\xvE.;tJ$ s U_w\|ȏ->Ww\^#wOiOBwM>ВDqǶaQs0gS@Jm&N C!L BKܡpv3;?@g3~ {*cw:Ko8?ʫD8坾B1:Fkj g3;z -%tWCg$j*=vTK -?_/OH|,Vw|O!TOs9 \x ikzFͦoSΙuBk~S?܊]qS >$ lkqs
7ldbATЮ[mGf nMh|ȿձ]<.\mH;xba ֫^1̂N˚q|p<' &L9#gM4Gz}{+-* Qx\'Qa8s]],t kyÅr6<o﵄H⸜=T-0W .'K&]lnwQzuyO/x/9_٣܇yP:8ۤbHP&k\hړ}f?Wd톈ylnYeFдqogր~GMTY h1|Ss (8f/.x V?o'?,LYR3Cٔq^^̥EvcG?Q=<.4]?-:͞$ { wp|z5ߔgN ֥v$?d_g+Mx!R̮ޓ).Z; &\WNzf xذS%#y]z
VK龔?7} hZ\ݺOxʅH \RP)e^DƆI2݈ {Tgv!]YF dm!` 6KT\ڋK TíaUc/9?x ?yqd Ͻ
)OqjK'ŧY'7Qb(E\i|K qV{ fQ%N"xL\j *{ |jSjv$NJٰ|]#xp)-@Gȯ F*9!% \o?|}ۏbs^)v+ P%_>b>G]y@Dqu pN;kr"bu@>2pL]X =$|ǯŽڧi+Т{=(B' O4zM!]C&au\,GRM^}W¾__1{|$O ޠbZAyWhU#:v,S[:BM^¶(b97\J^[)2o<[ߙwg6!Pf(RsSנ`(D ۡC,{+>#Y͎# 4
I{pk-툰Mq8aWUz]|EOoH8- N{ 5:Q o`?wwl- ùY_~}Zo")vqE_ȏ]I2yݏ>*.`+&(vfA.XMTocFu
mt7`)T#P_!~Wkb+g6 6Ь=R1-jYjmebt`QKyzn+ sέ` :mNj_x|"]Eyy[_pkc2_r|x8p7Ms:ŋ
W(JϟN?vwܢ\?o) .3~uSg`%ı^$ߴM 'uǑzo.nk6@'=vu^l
[:=X #/h/?^s$1,f8@lmzn"G ~)=SX'sG6D*_O, ,Ͱge^4Nn}f?/[N?fRc=q9CQ苩G&iOỡ20Z'FԛC{%&,G__$/b <
7l85=)H72^3Y[52NiMaBߗau7ZDc#A;=̍Xl4A_G~W
Aq{~W ^P[XU'ր> ) Ն_P zl9]%"?T\[1JyttG(\H7 k$>T?PN[SLzYK
&M2nic9{汸굋a0}/ng/ȇx{
:X"'37WlCTQ48HwŽneA3@ïʒ`<\ `(p`}=B.LПaҎ`}.z̆زCd~^$LtkzövlLraU^H>,)9{uh H_58;)GeחMcK=nh9_5t#.[OO5a>!
J \Pu!J7fArg ;\W s3&K+ K][NAjHgvBFْ j1?p.G\Ҿt c2+#= R,E~ C @re_s߿IF/Z0%x>uVe TnBPuoؑQ*RGsz]D~ra'e?av?)aHXr#'|YU+.}e?qMK f+^np#4h٩ϝ-w^ i|~ O\;9BwvB<(e',6{syO #Ze53H]?нX姰^F=5MMR0v ~VOd 濫_X\ϗ *<{;W)WX zQ\KHatH]<y(9uqBRAH>/4ׅoDzߥ~HE] ù
+QT#2̛0GU 'c(2n K0' t][|
<-+xeW&F?( X8Gt"7"_l YkHsy4IUv -9=f\jA;I Q Ų`?$+7>$a1_LcJ!'Hz:@~g5nA"}}>hIk VM@eQEguwk{ IUʇֿÏKz>S~|M{'īs~D9ӟ쑑.{1 =Ц b%cŤ$?A)q5e6 f~t }j#bM]Ž^튗" w,w;VJo7%d=:SQc6k0Nv iccWx~B>qwPBnt)l2 b!k~ڱ2pyԼ.P]?- k*~^W:~
{LW\(=}PC9}z/qYou[xej-6.ci=p~Y簜=_̗,⺈]GWR ӼP4I;ovNXD;λr<)cڝb91tX|%z*DRb`]=A$)}%N&
ξD^0"v2!8y$2(un&6hDl"LHл][nX1[:sBJR}s4`بhQAJڹ:Hyml gTgdRބW%eoèi@QF7WE{MM2y X.HKikwɺQBdOWZ 5'w1>_K
zw鑧fY AnO So Rag(Ə\}UBX}Ian&Mrw\9^V צaоuؘ34wͷ^P>b>sfĦԞ4 b }[TOO [aMPP)#x=tvf|xi{q#|76T3"LZdIСQ<_ިx|1%ѷӕ!k[u1_ 90&Dq`D-MpH]1'\;E0(lhE*~ هQQ%6k35=Aq|PV2 Ӵ;@Uו.ATu Cc$xKDt {fٶ
~X}]O&,럥ᩪ ո]/rve9; Xo_*7Ͽw J (M:$J6LVu;"Noէ¹A ^ &mޢ۱JSeSÈ^rO%CѰ/$V0r+~wRiFWX &+ #T[2M|hQo|0cN^nEߗ>ޤ21 ǭ剕My! h6`5q,&s]y0gW<҆ qQ?WKԔ7p;^NP]Tl31C=0Gl#59Os/ܺj-۞#L6L~3wsb>m.q8/}m>q/X75֣pI.s2Gݺcrpkp}UTv? R0$ >.-h
ڸe;j|Wy
5 "Xxv ůGy+^?ֽ* i3e #qP|}fyP1Ƅ 5+0qA,,RSjvbPY>|,NC'k HNDaa,BSVʜ S G6C=kZ/H yo_m9~,~_/p8a8
{8!84qv70t +ުy)QpH 㝙<rD}3G{*YCtמ=fQ.AjFAo M6 !V1{wxaf 0R .#J_rʦZ?474mk~z~|FTiK*ߢALw\3旼 |5 KpGcigߧl7HrѶw4dӚ\
)TfOD멗w ^FC]z y.5?|y4dH 'GuLC#aS!$NHDy(7I5FqA_1i0QJg2ɾf2z4D
` {9#'H6IaVgVL?ȫ9 AM6娼,WoYo{}շ
ŹS5lsU0mw6 uD
'?u%yߨ7@ pkh3 ΄ k , rwOCBYv
h C Z+No@3Ah "%y/-u CfY\0(^_ :IVL_l5T!T[a'8= Mun@ 싿pVBWKUW'qwQy~|n8l+م@7PJ06"ڠUz)q?Zϲ~Ԗgۏ,L{Q}{C yr8 t W @ %dׂ?CQ<5㺤 zV m튜ن"z4&ߋ?R-_QݙvˤI߇ "d~G]i44 4hmRr~˓,_]o.>Z W%e [gIj
/<
R Rxgts?ct"EʤD7 $%mħ{_lExndJUЈ)H5:ES-Os>9]vZ! U1sMז&}>2=k5DE3C~ŝIUi!Ctj BCg^S_50\j9_qB|}_u˗ڏꌋLj76Fa#p# w_Rq aڝwFuvhD wBcţ(軗wJ b7(fݷȄ"
e-'\q
#4;_ YeVl_ ̉BPBv7\)QglX7= g;NO\d.I`j m bRcD/0!suQ-D"ƌt~\] >꼳7 ϞX| weE9Uxxs nwl'p0)? E:F>OJ]Z %gV]Y7mP^ͤ8`w5{e3jFt'7.+T6[Kd7QrCc؎9nk
vWqpfi2
Qtp4'CR'f
Ü:dnmBtޏH.2g2d.<Hq//oM/}/+Nq1>_._.~c,zPrtOpeԥW=ZwPtً
Z|H!u$RjiE <rQ=΅_^_A粒 D4p& .G<9ԾeFq ːK 7+,^·(6{u3,6Ouzރַ{ w׆;胯~㩳}Z-<>c hy 7
ݧzw/ԣ WKx̗߳jOOěY?]GUX c_:J(OHW"i r/KO#WM'+ʸ%op#jWV+] 科@
W2<*kU=rˍ y/n* 3Mo| nJMք y:>]G//d8\xB+KkN}p|~u镍 oU ٮZ{Ux!/R\rZ.X -qh]ߪ)XNoK kNnϧǎ}͓[}~$7qЈl綰1J$3R zTͻ%qg"ب|
wy˖ :b˯˝ e;<+U;\͐ k
_sxd
U]I&0ap
.] nr
eŎp lzbT,r?x an\^T>ElcZ>=h[wv0@/u4IyⅣ>|[ذ>#͐>[ē쇼
"IX?o_'~H/; W$|0b:C5CT ArDJW u48Jg}zGNU\hy
GpJxiJy,^+uuXmu#WDP[_I?^ŹFO,+l>qO~=zgCk=q ^RQ
MF㖭^WRT8 {| ;j+rK [
/o|;)2g JCRkxi^dq]jy?ُc>yj:tTk/Ckw|H=Lv-8fB%mwbF?Cp4s|?-BSd8"~%AhF1ʝg#6`ͳ7Õwb(ENC~l_ Dž-މS7;M ͬ~BDuipWV/@WLWףI͝_W :eg )a)b,
G/C*quTA h-zm ]]GM~bN[7Wc9?ylajԑ*\aGރXuv}ߓN
3tO g0qt~45}y _V) 8H ?|͵`?s)n'[u sִGm9w/܀ a 1hn%S'5 @ Xu/?8u'[?n0~zʔR NJ2PpgzJ G>:~Zz.xxled*wRW
_{a)~G5^n aؙs+Db=-w
nBg'(ѳ)&镻 w}:
+'T@ޘpM,z['*C 2~Ze ckm|ZcMjaR8p_OorEs%lZګ V3 2hԺ$pnℴ)?Ko? W*Co@{}i5еvYyX>߿B>_݈QH )X.^Zy>7#sZW~ÅUU
Gz1./ ǰoZ ڎg ίa
t˹0NvXS
A?d#ag~ș )<X_n/Oy KƦ)@$kٰ`\%Ǹ!b C=˲Op(FOr vJĸGPM.C\~?ǭ'#km9髥z֥ *ф_0C \XM.GDUR 5 zy -&)Gmz(|DI Gߵr+fx8E
0Fȵ" 5ih]xPi y.T^!ݚ0AI߫h?e]l|ŘN-QsNj c}t'
:?\1MyzKnL|_\. j9"m-{лuUw4_ D#P9f "ln8
۳Zc#ٗ_qaTNỵry:껻#M!'wus%OfE_
jkߤ^Gcm($w~:ԜNfD
w'1.zkK4T RRBd?~AkÇn@r]'&Se
cD{9:Z~II[;~w
3\a zƸ-1DSm
1 agcC2tgN#klo(R}LJ o`'=->$9y/,Ttmg4 _j_9$ד5n߳GP~$XMw"waӊ)FPEWׄQ`xe0:w;U]GhqD %51G5Vg>zVEٮM_9W o: ḍlX>N3 NpCS a^tu8{[ŀpp4
Seʠ/v eXv4oZDZ-oA~eV7Vi~[ \Fv% LlI.T/kC_"_d7sCo#2P>U Ȫ:kBEP%w[U){QrD4J\ ڏ)NY$x
, zqT)R娗v 5>ol`Dײy3h~\m4drnE_\>+-Z7t4cꢨl>: %;0~+tFGGRo6X
eʂХ7tGI%8Z"C)iPQcھpIzoUNW ji E.KKQϕĸeW'p
GԓkP\vik6ӒT/\+., > 5*mWPy70Awf8mj[5䐷qJxK$zVHs:or=wPG-GFPnNrVnq*DgȪ6 .Bp?^Pc1
F U]TOw{sݦ.$b ?j2pu'͏ )K~ yE,1,$>\3] Y: OHKy9jR&Q3ԢJaEdx婣4Ǖ} IrNG`Pci7V5"C|$3O:]0t"߆uh%IXIj-NjJNwXq !ㄳǤK;2_K("Aր q%}!m7[DSs(/s0,cҮ#p` rw0-&NT˝٠pg !9++G,WKWR"JCj)Q{7տj- YOm[z,חĺX RIW lWR2TWe<ϫd##Oypz.2W?>Uk f*>zxmoEȶU#b2'W_ɆBhYYMkpS 85 rɏS<2AaG vkeʃ8(; &{ g^nvkCw>qi?]Ag=0Z>|kZn"G:['sOG^{^kP.|4FeZLe B5kjM#Si[jeE8C%V6M'L΅f"*rS&>\SvB/XbE@{JW 霈S|Or`ūzO|'FOW̡C6\b#,9=7uW=ֈ+" FlRKG'OnE>WcGA
X,CKDZ K]۽E+nvArAW(}6ʮ4^oGV<6wbDL{eO}u4
_bO!rZI{
*um=IYl7`4u] I HgNwEd%|!y E5H,=Er!sΗEgݓ o V"Aɶ5hdz*q!͡ >wH>i?ag"K)!.oQ+>.Yj}pxoеֺt &B'.;[7|8Dv?w0| rN7}9d
$]Sz#%'O]SQ o-ct/|R8݂oW$V\1EŃOh4k_^xB- W\S t5_Gvﴗ4 {Hy udUj23f["CJ3S= 9+lqcYoJ
@$H'/l[8_-e|ޝv}
eH$ux`whW8O^krֆ\|<ѕ{Qks˼zM-ƛM{[6{Tq(Wy } ϗUMc=o) A89s39>r@O&nHaۚZPQPlJ=P#dλ2J
7A-~({odj?D S@+o yPƥ M)dBd}Y7 e> në[͖p8o/y\iGs73cO?,#[j
ǻ zx^u`Rb
\@XN0J[TPz/,Y ߿G c[v~ ӯ6r-2tGv. UAIZY@:?wܡms=}q+7b%J) >|1/+EUr C2L ju z Yt r{ds<{NLx~~c
Gx9t$ B=,eJ>?R#
BǩxwQk!7aouKocs{ 462?
w AY]?wcw]pS
qf E8ct8@[ 2Uhu4Ԇ5!b&ƀ$(.tP ς
Oi1ӮEh;.p.>cP} QH>and>0j?8Vf-Jow}&I`Ao2^$nĶc|; s#MR7(KksL Tۙ\׳4oxYW3n6SB%h 82@B*K$H/"d3>PN
UQ%h={Q2/#O.͋j=~qhQ*:|oRnCڱ 'pwՓ:RIf\ߥ$w@Y O R H#ك<^y;axf3?ʓka]) t?SRi; W9E #jd Z6ort]y}K'&3e+~:m6|W(R<ؕ w9lir'|ՓBYk)a4Ezx+S SH >L+yIw"WOVԳ0dT%VH :z%e Q}d2]vҩva3}#ɇf>`K!L&XY FGr^ԍJF.8~d?j+S5kbGIh4#qaޥZD &u֭Iی_atÁw)tҮ -(iN~096-26vڝfsRyY~އ얷,c46)D&˫]w"beWԇB7A|Ib o
U<(C3KyIcXVC> yT[D}ޛV`=Ժ
I)v}흥>̄ \HGrKI 6a5o}~ tN SM` I&6G -9W.O+(0%UDI6IU^!Vj;P{;8T*PcizJÕ0G:;tlX N "}Oסzg$z%&MUz|NzgOVBކk]>(\q">@? xd ,^hx-o7xn>Ԏ,w) ;J6oVzT!K U{ϙC<4֢U4%WĞ~{%V |/ܶۛ~M>"w;dUWY С.U_ޘW0>Rm>NJ~mzAa1AWHl3TrVkAa{8:fts|zSF tՓ;+;;4E/αCAHjUw EmL=BU0H?^=^#_!ϼp?Hǥ-ͷ>p> B>QGW|~
^i\ v^5
+K#_${wiVa eevmCv_iQ'K}
F99cԩ}ʳT$.#fȋ1d$V|{c~B6AEˣW폮za[ձ'hrm=? {.N͐ZYM-q
1JjP缉V鵬d>pބtB?rsڑ"ݸXO">Z SՀ g?
kH]Bܟy~/5mNoȾn}ՙ`/jlhT"3_0+!;&Əw {c&Gc ͕J? t^LF
YU,]~Hͽ.|#Mz1|Xc'ݎm$ux5UVޡu,Q> 2K+N&Ca6
$pA_wj ,!Cw>?P=u7] il!kq鈆^s1
_֬ѓG;=kތ$6V^c2Jͥ]ِ%1㝏g^L :P:MqJ&T;OA۫(vޓ Y㼅ڹ~{UF&"!B1ԝڻX^s ymd _6W| @l"k GU%%'F.)FE!_<[COn6uYZ:Ij>2$xn|wtU^S >
NT|Ҭ6;c7¿]4Ш"opAh,mdR
7 h(C1noK]On@֧4w(3$
jO8:CtՕW 5k:~ͮڤ{ (oZI$i>U^O0NUMOj&1N^Iq_T L6Ui5D ޤ*g6n{<3H4\!mqcV̕Cu(ϑM[?g; CM SW2JBX6FxˣmgQ64M| : Γ_e,WJ^i}WZq>o[ >_FowTDWI+VMrzng?VO.Q]'K ĤPfLGM:+<ϑ? 7ƃG0;.|k)F]/VޟXP:f%v)eb.EI3c.XHW/)A~W"!>^{G Rh]Z:د\$ȇ чG^ :hF&b$
Ⱥt GH]Ve
47GԿN?Ck3|gU<[*#=*M;7T OMC룋*tsE ~I:1n
F3fYk`<= M1G}9\A+F4MM*,Yǚylr hKw0uoDTCbU(yZ.ZnK
hl` G o@{TLouTAwFm_Kiss w!'<8xsH 3c`fBqH]1/L ÏU Gk_bTZ.Ͷtho`f7#B2=!k ^جpkM^EKmUpE|lC9nf|fʪuz?.~K0$)m%V|S;Jb-,ƦD^FR TfC{e(gX~ ٖ- P<
{oхFfi9rE9Y'*]ebK N,}\
%!a n *gLGHh
OF)}{7*4x'ZuDw'wJl@]iu ,sRe?mjGض+ZN~\+[IYנEeA bUz;o1 06pS+7Χ~.&g ih}:fK`sy K]iz6Ugo :7 ;gB?#c5Q%ih^=Q|"RwȚ@s+~( Ç GFI)QV6w" mûğA:g lQ3pZ'vzݫ
$&mU
b5O
1 Fa
ACIz&g16sE ǻOd֍wPvmN=
Ǔ&|`&"( nGQ
eot.W/ʣx ^!6 '~Kpd)OUY:ST!u.*`o j0s*Af묲> S{ U0Z7gO%Tfnh/ >ѓp.9 t #] *oN/'.?n_lr&?;>\Fo`A?v D2;wY/JHQS\V.Qc*Ly >$1 lWO?,fu5|%Yb-t|xq #ɦAqGV^{XQ% 5is:?A!?VR?L'1'=ꥦ H|Y Sɮ<1H !?yrэ}e2ގĄJ>{+̵7_BȕJ~xQ9oX8#[W[j["냲?i-=<_3Ñ>B^t "$ 8G-ᨳ(\ ˂뮟IVϨK@Վ}pxWi >øۧeŗjfy 1IIW e;8cD>m$ik?!n9kk]Ti 9 P~i7ĥw g,7 n%k !Hcd^Gkp(^ !$"7)#k+34UY
fq\!yl~\-{ FvXLB ֒ ˩Ihþp>^qa^<ֿ͑Y.[yjȄ{%^ 2j!WqxLwhKхWoN ?b;+Egε=:ѿvTmf/Aq%
Κ@Rz la?0Gp#T 7~fEX1RsyqgURCm1eu[o :\bl GO;&.HƐ5̒<㇖#211r0Jt[UD}+|1Jc:~xpK7R;e>q0A/{n,s . JBٱTKq^Јi )B?J%܆ AYd'[kUMxidQ樴h(yD(Y1Uˀ8m N>P ݊_CYn2DyyiUr e8-2$[>´݁_zrb*IB*ę"ʣFݰ}c:T?R>, zj ~W=&>f]Sz-5h~rZVNϙaIZb;$ޝ5 oۥGzɐ=R'mŕ>4=z#|^)9EOE3кEq=
y אE!vNrswueb+5.!Z@u< t>@HZތD$ߺҙ$rN+b9$*onO9b<5B rhSJfvla3L'B}<d
eB46Fvۆgc&DN ٢ys2"]/jvK[hö?! 3t6" )MV Ra6( [|˞\\<=Qa.cr# Doc+{CjPFh; o^&Hۻ2#)5X@(DDG|UKw M7/>tDsT SN3s"Y^o{8.H7MY*,[䏑{:Y|PTDӻc ͲrE(m:^A#RP40ɿ4zE%]YKq7nlA[s(fBmVUGABh:,?>o. _ ,7!vw}j}mb8ʳI'O;Ax<}R갚Ib< o69FMWr#g
$Xm=bCFA q%+5֥J3\ko+BQ*7 ]cgeu+w>M\UMHd4Ogh>4Y=C%+AyhSz~'5 s/rR]I% j~ 9Ƌ~
VS &Ȃ<>!/ʧJnkPLmÈ2tr^Qǂ`,'I#T6k.mX?^ZHpr>iL
%
lh+)ϱ}s g6lIYZ[ 7[e}w,rҶW%B1}RZ[4#z5<ΤVDm #*#p0/V<`/w&DrdS+)|:їBbΔ9 h7`fy\&adEu-2]1Ă_Ds3*FG" :kCLu|M#1 3-Mh[Gtޔf4_mGe1bV N8P"U% iNPwl"6
lMTӪC ۔ Е&~%6o_ 8f$kf-] %h~2e)/%/%cQ_OǙC5(|F/upӉ,ݓG)Ug&;b80.t(MUUb=f'f 7/ӢWYtI|Zb#GˠCSW ^IIq{
+C5W|{1 ?ʃo?8?>%y(أmaig+Ȉ5;0mq[Qw35 +ƋU|_c(o^j 8?.8@\
:bf]
mzuc|rK=Co06vzb']tݪIܛ; ?vlN |s,w0{Ә?zT+D1%wCUcY7HbpF\ݦB&USl8aCP0<"ؒ֯ ۟ M( z2,˾NhG_tӮՙefh2R»bWC$ax ͫ~r d}q jȞ
ߺ+8E&ݩA(* hҏC$B &Fq\2$ApF\I1YCP4CyXLFbz A#P~8ݶK nۅvb@Ra#]WP3AwXDS
d$66al{jIq眍G̈>y.eUɣI0~[?6"eO?=V~!BdWrH8,tgƝ npsφB*Yv?zji}C韗CAn!&oY^km?_!c5jIȟ`wq۱rC@?ﰍjG?b"cAEV?8@(c,hF: lU]Al~]4d[\ $VK\_5^/5d.+9 Hf'ILh 1Ixc[MyCq#)PϺ&(>!z#}
q/h91JPȇ&9Io`]z
J݆OoǀҦ w3<;.\g'i 6c_j|
drAiޗ
O^=Zcw1hVL`N!ՓT,z` kBs(š##M,!Z.x ʈi[&ZF+5_s\uHTZCG -/Bېu?֍[
ˮ= |03 S%}g,_@Srrvק= !N:U930cTĊW#hʙ"uۊi z4k-t7+ ġNFɁ=w4-+-GΒ.)$js %Vzgb
!.tWw&ެsZy90f$'~ 0t:s 0^r.A=1!GMhOaDž=~:~-AiiKs#/]iʦU| 2M/< `|[}N htT+QCS°]oC>ղr}ڹe6#5 sבT%FFaP iSff2O뫟ULrJ_+ jV+?p^4zblruCZܟn17^TDkچfZȌQ+d\:w._3C b%ێn-3vYx
aIeM{nb{wM)ی \ Ս \zx}Wս|ʉɇ FIM1$R%wG1Jv;LoZz`T4E3گQ]kv|6}r5o?f_v{~$ӿ^/C42S+u=)Պ0#f q@`9ad{U3[.Ld$Cqg7J{>
.LјVvs>6H;{/ l.0=.}pTs4.7Uci6 y( C`\ fo%xS;6b\C ιŴ& `jE32k{`P$ʓ(w7ټ+wkF=ޔ
SZlg~g&_瀖;qW]B`Ԛ5Fkj:gLns e|.]O$(,87%%K %Vb13Ǥz7_IБnb7Ui~c15
{ '(11oVՍlt^ΒtKBn -֘k]ZKK5I~Tv_KL*+ IȍfUawQG[Z ټO9UI"@geHee>Vl<GU A|dvRJ
lW^Z>Yw =~'Kvp ^Qx`ȝq>tL>g1Ũ A9w ]ϣ|q<mH%B9sLf}py3d6`Dvj=:yډb vppYTwȭ<)BW9#{aȩ#,
8 KUVߩ}f]D3_uP1!S-đP4tDŽ1' {}c
Gwlgķ`ʧEBoZl| X&*Co m?i,T`Vk # {V2`ȥ4S<O 塄Ҳ|
x>!{
/3棰p/0JW ) &"Ь→Id/9 ,F\|:QųP{ddN I'HyۊЁ9R@,HR+HGyȅNW+@p鼘sI ,H@2ޢHpVL%=
+8U6EUFT(ԥWR R7 aޏO+ Ju[*']'( }JR~Zi@2 sg ü+
ٮ9h6xr - I [<.^G0ze6|&8ITaLܧYAvzz-lR!aٹ <#+Et^ >͚uװm
CXss_YF:[ky 0~'/F}KR$.)]\/`E=.؝-@ 8.0OojVhX>QMyN-ZUV>Hw|+ѳq[F:?i}J?~ OsR(\jM:oAb#_edp}0
k ma&%\v~u1PgR ̀ V}鄰2f
F L>0X=w,
rfV/'£B$t>tlՀ+4-XnA4(?KaQ%S:f2`y{/G7EG?ĬH1I}Ӟ>78\|:a4ƔL]pJekk:ا #;KnS_қP}q8؟&7nZQ;
78K$;&iQU彵`;2U$
jM@+
snZ..d_fC+(dB~vn K*[I`6oEY=X3K-m-QIMhK Yo }B]AӐXB=[h+B?uZ/[~@Tk7
c^[|G.jXiyJ^~ fEtЮ¸kaCi-VвᥰrhZNj9UbL'2uxiƉ?83HUi}/LtTtfӐ"[ ;h
ٺ ]f{/QdsȿkCzy>A(ݼXS=ANJN0DcӬvy
a,!ak0N2{4cSCYHJgìO{bW~˻bUKнKd7kmTv}XQd
H%֘r g:cسpG0.K7ٷ뫭 2HvCHX F"rws@NHf . CXߟp9 ч9 w
`.ws0O7l cӉLUO 䣡ZLT '(A )ŏ;V.
ȓin>wE> H;uS,>(u^Sz7~V=L9|h'I(9U184L [u`=;(3 J!jPsa˨%زhbsAg3RυP{͉x ΄ +$kcS R3/` W4afzn[$3yXn ~o͎< XukW9(TFMggv@gO:$Ioކ*8$?y1`)zyGZQf-$y@xL)탖g=Pf\kBR\Uu_fd/C Prf_
OomP[ jo? >E_48`hT) 6Dʙ;qQVKs&V
{`vBe Ӻ{[ Tk1 3X9[i:0iA2 fv) z
W k^,"R"ǧ"$ @ߛ D}4ƶg (z%Ȟ\E>&*[Тztb
l 3K]+#1ÞHYi}Ϻ ξ1ˇ1aHdt&*&vFƗ3"Q՛VQgtVAe>f rb3ZzKj{Wglq "3-?Zg(
s<+'x ? S]ʷ4k6`{r\m=[BN [tu6_h
z&l Hծ)X $d< 3n0'x"l_)剦vZ
U];zpe,nJ ؼGƥ !HIe =?Tw' Cf N$eJ O3uQ((_Ql{XY a@$?4ӶH4{O4E+5I5G0?[1wD϶fHZ4iYT¯p42˄y㏓h^TY Io(+z g"c!Gş m0ۯt (|Fj!)aXbo'
K*ӷ31"0qGf7:|_u]C1TUw27ð^@#ՄMlҕ &tǟw$³)nHȲ7JvA9Ȱڌ=MqBs%2 iD,4Fu Was0Nh^ClWe`e=M6$= ƅP"{7W eJ6 cXEDH\lVV<{_\&K
5NkX 꾩1\6.Ys7N zGloi:wܟxEVm_>UNw
2 \ ȤJCr58sgpw2Mle:ğ<7y
?M}#K,Iz,a9(f#+]1~CH0|L/ C ѱ}wԑB³!RYM;Ct?
fpWokhP7$vI
6FQGEGl"U75_+X 2MHQr3-mHҶ߆a*W iMTFUڳ L?ң ӵw\ U}]Aon0b:3_/cU( {qO`\-
hEAg_ s0t`~V#j7
Z w $./: \yKs _߾W=!uUv4PnD"9CEH$sR /E $7>!d#[JfŘ
8vi2BWsmwN\Rܺ ^Lf"O wk+&#I-}H,yUՒEwĉц -u |';:|"I'Xg2;G+/7'dn)?jvr!r *_ђ}42Kx1u ɦ{Ƙ\AqL0Kb>\bAN2Mc5H]OpZ]yn!e;>$E~$I5*Տj| + G)8
NR4+h\CQqS'=S
Wdxp.-טL`FбP JI*7Q_;0gil 58x'=V0E
r Hƽ/W.o#_ҹ$<JnY Y-=EbΫG([S1ܮ nICˤHh:_lDGCP %k*>jD,ݟ`HwSE, Y.ZRD}C b3[ ǧv1ȝw/d.G'ntknJ$_<>$.f[wF&d[<qq:3Г\c*C7dH>
g-ammFrfq3 LHQVmf K< -_ CWH?lI~:HhZʠ\IJE0f!1n
$Hf4kC d'rݒCEҙNHbiˑDFHCd`^BL f @;22KO2RSmi)ʍ[Db^ ?Y F]sXA/?z>Y_5חoT룝t+{% ~-=M"lưz *Q. +6,I,^uYBɏoCSԷ!Xӝ ړzȮLs!3/솭Q7DfSx@d)_Lb8mejC{e7B2nM$
ZH2v0-XY"{D_ -\ IjG *U1;>ͺ2 SAτc%RWnwH}:1r} >,/s2C`"} Lno MsIpZaKi,zgz4h>~iCz==NE|J9$WjaV"Zw!6V;HIHvO=,:r |ְh2A+~wBڞ|HM0#Dϳ6?+B\bx$%OsmIG'|DP0$K- )Lvt,uݐʫGHZOi[\u GsYHG$o/\ksվ $tdj eEiO*8&襋T`h*< 32]xfXR#2] :݁Lꯄt qr e l2c Hti-ȸO49V
uH} 3ҌIyiR!k wB\>q pDbU"
{t-d|1tN)eBBu*1[ 5?!Hi+ bOc$,ſgT˄ u .Pp"k401 9ŬEPaDIY
Yv$zԗ)y?u'T9$v#[zBd^e>顂˖YP,U<+
s}'{`6s*7
[f>%>*n0+_۞ k [#+kҌx-j!= xo2rؚ`pc[/ܐ$Ց9REFP#c^_Ρ<:Rio&ݾ
H_u -d;l"7 ZwRȇ (:ts٢L{j|_wRTtDs$>gy%Nn\S42Gn"iU ðKX02'/6;/U:*
>}n( 8vA8CvZ_ǭԐ^d. %xrz?o?k o:ߊ9}CaMV6>tꑲ*",8Ěݛ:Ȭh$ )
)R Q LEϦ1&כa P'D_l{"6E"Ҹ g+ti'j"k|7Y0p|X3AoIsPp:RdMW ["ڶHFa{ULw5 ʌK5;91ROUG˧HҘ;3+>#䡎8,$3y$/B /)x ܍/,В^o':4& t+ސ'aR! s[IJ+_ JW9C0 ߡ
<3:덌e'ԊPXNl&} F_εAg
p,]0!܅1dN>W+ jw
<G%nO$DpI[ޞeGfM-4d59 u=PPϧOF ^(r
dO@
{QQsbS"hE<=Ƞ`y[(v@^D+HKv]$H|O4 ѝ6K0N"]n!:KʽD+Rd q^`{ &( /Q3
M}IG.oR6Et0%l\ԵS\u't3H ]:4컆de=¨(N2o!-hR d}7r#O_Cq&$zkxiIl{Kfb=ӓ[HR]}Lnغ
2 ϋ$%SJ|fn ߁]@y1הjz\.Ud kȫ0HN52
@N
~;b,(YJ8Rzæ&RX~m53
6 4927A !k9i9TV87w\yCzQ;8+3
3T_vQ R},sSEƅ^PvB.,w Ty a|a.?ȸLuתoAJw`Md/2<@t nG`^U2uoI%wD +:`:
X CWo9߿@Z2[Ȣ4j6jߔ/ٔւܲkNR}wtUL6'l F·Y5glnגuad Juɩ$PTܢ~|
6d#L[d:SבgHR/5aݩK!RlmR嘾VwxSn
$Gzc
?xg6&5Xݶ bjຈALp DoT9ITLF"ɑwYTZ3=6V !(9 擓7LZ~cT0D ?k)
+c>#O!ܠm gM+(<_ݸs^
@PHǞ
~&NFF!O."WC\s3r$t}z%F(kPM1W!Rs +Vb02ǼiX)8_GHU 4+i>ډ,#NxDZ[o!==izP@:ٵ!p
,}r sg>̷vBl VwO9Iewۇؗ_G Yq(sgN\gݤas5|G)Y(n }FsH$s^ ,3Ԯ" F\ D*Z/NnJ
;{cBY>$(o^^ՇGO~욗 8"A/dh2YI L9%fׯ|<=|Ր_,ۄF=
.Фd#Sk-ZHqX - k8J[/,bkNAǠ@uhʼnTx{)xiybw[&PEtk5/U41/NidיjV? nbGl2Ny;m8% @RGKRȚKo2"yB(fPgQ܂> qG25|TɫWGƴw/
έ
djlVEdHA|NbnQPH=rzSg2QI)#{d aqiNF倱G)Mp*+]t牥j'`"?U]HH ꄙu`[ӥ ifm05FR &xJ=0< Co$M/m xn$]uއ{¢;!*{ sh:q>}/ 5?5tȟ![7>,q<6fA\L%ԣ? mP,S*ЩR&`N=TB.'fB< tdV_F63}Hl|G4f!Q5(Y 5Ȏ/ SYPԬ7D; e'Pz@KQ٘m8?ϱh>,Pu#p opg(DqQ/dhv^
GU[S3:&E 3
,\7E aY;hPyG {9I{QN_X DÀD.KԹڼ $&~>;8;.!QcI$pmc;ݑ]5 <6."}Ӈk(ZHXw B Ӿq4dn}ek
o G)!2".W6z۰#P/y^ 'Qx:AQrxtffB n(:길fٌ=PՅO1hJ*1r30:6}.'<'RԺ@l2!,z
iyr (mX &A+(xp+ 2*DN \U c^ `u#߿T㇔tl>N.1ȿ<}Vny
B*yX') |P 7xJ x/pE:_HXi4=5++=?y@MwJpܮA oV٘ oշ1G E@ȳ:o'>rK>E9G USGx6^W'iU^1(7W=*nj @{_U#! og^60
`mF1oOQS!ۯ _w e.|kW4"yЬn7Be O/#VZŊʧn)N#!7H_,g}u /`~MWi$iʃYgC]04N$V/QUK"ńlF&?+sg
7/ϕWxaBgRAg<ʇ5HG%}h*4fV{ޱWmGP>#sIZ̖ zOgj #O( |qY w!Kzw6/(N}vn2YTFv(Kr:%]q{r
l C}8ᩳ1e/ 7ʯ0x`~6L
ޖʘ
M7s+&$tWb5'G {(o%] M ۵ Y}Gv뽧 | 'B&]S)( oaz)&<@*F\[T@svoQ$y%n
VN4(p~ eZX{/VT)VfrN",[P>'c[}1ukae*ɇbbC.zᦄݩC Weg \zIAyi w
Nϝɂ%QXwA ,ѴBv*O_ܧ&Y~/R_4N!gY(^&u~7*ek#+o5(fl~ }g@UHJ['X=IIQa$֍'#g~KdW \uP gF Nv 9m;IE(_4Ydd . j?(`@w >X[q=Ql lc#{'v %uO, nnv]H8ו?+Ov%8w<NB9]ƇY-4nY'!cYV9hܧEZiQp~5&
AʈaQ^
eEa55_
@texO: z=ER nk@{ _4atlp$ Oz ӣ_!K?tcp{r&.DmQ [OOr
y
}A2oYxs<^Bkߕ#l%ZK=%,1Wu:9gI9$'O|; wNk өdWOgԍ˵7i|1vJOId; Z{-bVy 7% Gܞ
] Qh ʒEh> ;NRX5zmʡ57?d6
:7HBw;L;xV.kJ)o x|0KH쾳O
2NOrf8+ "P@w$&1f@HXDz>} H^_UC(:؛ 3OތyQI(pi*_7`(jy z XE!?{d3
oyn"Vman/6 ((u),~ 9sD& /øfd
{xe4 ˯R&;vt3=5̍ҡ _G¿yǒ-td%\=J5/c\{=l_|lY cz;P4qR]OBtHS\9{ˠ|A }v# _9L)CHjWzق>J6Ťթm !}6P$gkQlM{&rgXJE!J*k@!E/GM CGVna(exH}$
b2]FRٖ X^n^t%) %!(G(x2hn}F6Ov6/H}ƗnZ{ d
J:F!~ۑ (cY cI6lTEQf,%$,: šs.nH8Zw̜Ҍ E-;uΕRw]+6k; y߫}?VTDq1):CƜ \_p
5CTt`f=8e6?'30Ikh'| B([]^T!B7B3]Kѝ?6I&
F g_eE0xn(8_z1.x((; ۤ͛5GӲ] ec\R
g3G!d,5G:uDWh(iWWWOH ZB&i$ VAwXAcdKTԢ rF;qva"QEY%_Quw'L:HɌJRsc]>MKwpY -FI97#pD":d#6 yW߫<0zb 2=bY)GFƹ(; EA~E+J-aA#;q@u6xd8x>3 wc 1=Լ'oj;ooI7^ |9}pY. FL?4#inNbtE i2"gbF6]|<_w
kF7!%,&Rh98LOB֒s!(ui<^)#o3(YJxyܫ̈d"'ޱb6/n< QHmdJ}z}\Fo x K|2u\s Ӕ~g({
4ҷ^!yI+N]?Ͽ7DԑgE9Ջ:kDY2.f(70)YGV^}m/Gפ;
%X.&J>fyz/ i*bv-;pp]TnmXqߦ;y^Wwt`6L:l 977?@?|l gF7;~ΟUFu(v5oǏCyum=~Kc|ۙ(]+R3Ì$ۻ 0zCUMVlT%
'M#X $@b>v@dؖk&<Ӑ2e(2DG_
ED5%= ?Q߂לӵQr|1f e u.%hJMeD<*m36]0f
S w? 6j쐏?1Zheb+X>!5T-e/dNv4hpU86^ |j G*Eػ0XxbQS 2k?N4$CK%g6+tT-\oR A9͏
< jr;[*1ڕ -f|`a |O|l(MՉ3'vNV,=vV0>#7c x;B$ӛc 9<;"i%|N raTP$1[վ[ Mg3GNzȥc'!Osɖ Fn.dD'*h%@
{~q 0#5Bbo3Rjp8}5+1Tu# /ƟD+P8jV(e4 9Ue a%AjֹO\|zdSg(r@w~K Qn_vOX<[H\HLՉwb94?FhUÖrn ǿ9
+I;/T
]LΠBPyold *>3OUc QsRVrzHzj"_?3OM(C/<& PxyS2э t Jzl ie
EHʮq R 9tKSa&6py&,&durZy!+w[R<>g>U'C&|ycò7 F-Ҏ]^-BhD؊{WV*ΦO>q
Q§N;K2 ,r. MK`F86h{Ϧe"!-mޘz?yV,h"ő0cЋ4o 8?#M{Nr}:Ț>A%_m v}bg >"M$ہqs|/dJ*\ᗇi!o6\TNJ5 ShDFϏ"; &[{X #UjDUu4_dhbc,x8LAO)n
OX2.MI]C}DTοE [:.KXu үfS5ðHF[XDVdz`>Qچ~r)4~ 9U s1$rJi
C´iRIjr2!Ұ\yE9 V;z5ߧHy0z'PUkd5̂9-p7ԣEL5a9X#rI }bUNg Hy <ʌZ'r\3!݈!TU%$[b@!SuːvN[:`
-M˩ױPm{qj6JU "՚wp 9 /UBMƄ w8%}2|=c}gt`>%Ba2zM[yŃÌ`M0RP6VvE
Êv#,^)FbAO6d 0{(LF*yʘ>%9=]nU5FQYQ@5;9VyR;0$t|ԍ ?}+Y}$1rX[i9p7S8` j燉琘 ZF{6IF<
3m?5"Wm%C0~^( gO.ָ/Ut|Lh{3"DIfUZ&d Ի
W G/AX}imX$5#x}{"
`1Kظ:bt XXvC 2{w# 뉞 d]_>TǸ; 25b ݙ'cR} 5n`el۵NPyWNUA]Mսp,*斑0KL5֨CGr>s'Jյ 0{.xc
57bv{LAs(NOnMZv~&ƝZJ!m'0RS,yV"77$a {2Y _s5n4y M>u#ȝp/2*iyBm[6qe１Fշ;pnl4n F
d[-Snw~ UN f0'z}xdZufEbd `pW֭ 9S7gv
o._}/$Δz(ILiH & JCgEI&|@*+M"Z3 "%e|2| A jbXGYI?cw[N"̙C NȕrWt7Py~ i to+ _,|o']=tig y y-;E S (&CneӏzM"Em- c jfѿ1m+MbWj0ٴi6~bnMnm;:Y4S!_b В{4 漭~Hk3&;>C2QAg>S4HY# φPZQ&Ǹ_!O2C8 ϣZ&x`קž;[k!&:ê=27?K`=u
Ց ]*u.&l.>zî~>\OoIɡӄBKrާ
:l4Cfŏ[]5mr ٳh\#C*uїD
ۑ>"rX%lן<iDEF3Q$T1Ә #~Fz8H]o}(mRYul"GW;<4r_~B≊ I#>>Ab{WFQ #
$ \js Jv4![h x JdY%hi^rz }/io}ȿ~kOf,%7N`AV37`Q-
923+{`yzxP&L,+v{8?|Yl9=BҜN LH_+u>R*8iwͫd E'S_ Y#s]
MGvY \ v ѻ1]AgQ`i&:Ē0grBd{~\r1ҼKƾ$5Ual>s y-
B'Sge^êםlOX3vP͂& Cy@\տ̨nV |T /Sg'S2"9 __??mM# ˯R3:°VceXU!&>m9&
9n]BƗ/LPSiًMv̀bl2IiHkU~W~\H&e7]\@%풑x}nv Bbs`6%<%2"
<[ʇG>%0 +y
Hqv]>> yLOށ ~^67ȶсD" f/Y#Mwѱwg`/TV>9_g "t7ƨV.1/ԃy١}rףì& ~*ޛ-Y~^R3R8_0+=˹fo`;眽ƽ sv jX⌑-]0+R0v>i%`=
vھ~+3M[Xn![ДRKPg7EI藰 m_݃. -~7"pU z9Zڐ>"x =2f>>y^l?G Ƨ%q+' It O|-F XHKvlT{I}٤)i
LNX7d WQ p;J+ŷR4
b,ru?2/R'K>75vΒ]F~z#z9)7? \=b maki~%QD2
^sկʴCkf`Iѫ,L֓H)mSj%F.HBqh )"(?Wu1M}HnN]jW#~}^ kJ~FD1od?Lfd0;I B`9i`<ىO1Qtt1,_w6#:J[*(, K\D"e)ZidH< GM?$| wLƗ3 (Հ 'aLûsH:yH-< %>).J'oȝ}M~I\^j'o ei9K.P4J67u
lzUlǗ2ByڑΦ 4ѝQBo` p> yw= )4"]11oPB#^f*/31]ь?Jo+T=~pXmX-Q*jFs_ðJ#|ݽPRuK7z] ֔$w"Y`Xd8_kEf {sx}Uh`G{uHɚi$
#Go[wY̽tW8Q!<" KU>Hm1'ZºIyuO$hmư.t#qjʙ!GGLr n@%cg&%`dNNX&x;k#M;s:z-}Ё笳 oXBɫ=
Pq&%?vr@Kx g(O J1Rw`ޢ CuR집k=6"#
'ɺas#Z/DLK͉if\тdKo#݂eS$/&) ho"Ed{2U'~wC@z4O)GZ"_$My>$TXCa!ks5*
xҿ#JHC:|P -MgN,X
f~Y|8 92݆HJ^_(Ք I~͛ fc QT$Z4w$;ؐ wU 2?i;NSa"M%d[~Ys
mk# Edm1pV@^+֘6VZ ީO{.Dj"Mӆe$2ȿd烤}I"S]r=N]xVvU"0 \e@z"l_C7T!dk!do:[d
u-y TP;VL_o ;pO]eE~tl*F~%e2T _y WDPj5C*CNQ[_ފx]v !h㺽{ ,]J~Q +CG$f ךl>^1 M0p%.5,8H >LiW/ Ua@a"Ny\c}KTu .T"UQaW
9
?9( Yf M9*/J͇G inde9Pu7 ٺ LP8E ľ v#kGki}MCҎ.3ZG/n>CWHU9#'Jt2R<9T-F\ {x~?K7D$igyfdh wB~ͳ
PMa[iK?Μ
hΨ@n}kj.<: BbQ"'}@^=0䳣L
=g]v+ O=B[ܺ`cIo$'@VPj絏o
F;t?A&)'w^6,
itoj#].mJ3r_oL@ѽUt;
W"2o2RQ C Yy<7'PP@X~zK'rY-pdx(Ud o#5)n%/ɾ}ێ5_O |RA/$ȼ[ՑJ!G*(=$O9k:/6ZӌxNc,gֆ y09v/Н K$xmBhBÌmЫ-;k5'!>7Pwz
TH"턐3S4]\ϕp+(5<&yL#D{^֊iyWbqUXsx;
)==w tc9+]G`(rTi"l~W 5) Cfw9r?8ΤG}E,bd[pdwkY=S !)B
~Ya:l",L4f20{j}}bn]BAuÙf(.t$
V/Ey5
lR3"+QFNo?r5t"SN/䯌yPR"߫!˕]h,U}(!}.GDPt㳀۰@Ֆm]ЇNn|8I
88jWLxx ^w\;InF?+ 3IKdPp4g?#ڞ['KY'C̡餚 |-8IU y\^YKnQ L[ܠyMl9vș
x\ 9*yyn#+Ϸ+Piy~37 j*xq?F] Po\[ j3Lw 9' ]*]`Tr-8"դo%٢
@C< 麉C@]b~d*:>?/ {]@GMR;Je t9dP4av 2IjSpBQ?էpDP(W'B!8O2{
x>M|tq;$vSb6_>]LO,mR>]t$H=ݮ DĹviH$YS Lܷյ4&3MOe-aBٶˬ*C/>jZeh)p(>5T]a+<.ķʈcoSx'\ LO I*K fm V,)#խŕv>t4&Kv ec Q<Vn{N;f W@Ļ}ę"0F+K\4`ͥVH,:V.QiƗ{v]qWqps0is{$@$9"0 NxNϟ
BF$zd\hTY!2>!FvH=nq0J <Ռ0C#
$~!
Re[jŻN߯I0$AҒ{^ ɛw
V5y<cW- k_yʹTpR^(x ^_sTƮOI0@gKh>mY
ݳ>N@祋%,aڼsXR
m hT(=) V>m
I9=HT!q lKEF>Nከa|lc ; vRUרޝX,/p)ׄ
{]4QQZ+/֬DA p7J^C0^(l`/#<ǎ}Fd0H}e)%c, K@NaނZͦ+ӵ`oG O|s| oX?x\=heU$\( x_ysMG43{!1JF;dO/]"
s mTۻ"/Ok+~v ( p 3N Iu`f0]~7W L{R?)m24t4i}ˎa*yƾz;ulj8cD
"@$e4NUZ#Ri~Q|m-$y?oO@@BD@@ko;/ǝv9 plotrix/man/ 0000755 0001762 0000144 00000000000 14116106365 012531 5 ustar ligges users plotrix/man/pie3D.labels.Rd 0000755 0001762 0000144 00000003232 14011145766 015232 0 ustar ligges users \name{pie3D.labels}
\alias{pie3D.labels}
\title{Display labels on a 3D pie chart}
\description{
Displays labels on a 3D pie chart.
}
\usage{
pie3D.labels(radialpos,radius=1,height=0.1,theta=pi/6,
labels,labelcol=par("fg"),labelcex=1.5,labelrad=1.25,minsep=0.3)
}
\arguments{
\item{radialpos}{Position of the label in radians}
\item{radius}{the radius of the pie in user units}
\item{height}{the height of the pie in user units}
\item{theta}{The angle of viewing in radians}
\item{labels}{The label to display}
\item{labelcol}{The color of the labels}
\item{labelcex}{The character expansion factor for the labels}
\item{labelrad}{The expansion for the labels around the pie.}
\item{minsep}{The minimum angular separation between label positions.}
}
\value{
nil
}
\details{
\samp{pie3D.label} displays labels on a 3D pie chart. The positions
of the labels are given as angles in radians (usually the bisector of the
pie sectors). As the labels can be passed directly to \link{pie3D},
this function would probably not be called by the user.
\samp{pie3D.labels} tries to separate labels that are placed closer than
\samp{minsep} radians. This simple system will handle minor crowding of
labels. If labels are very crowded, capturing the return value of
\samp{pie3D} and editing the label positions may allow the user to avoid
manually placing labels.
}
\author{Jim Lemon}
\seealso{\link{pie3D}, \link{draw.tilted.sector}}
\examples{
pieval<-c(2,4,6,8)
bisectors<-pie3D(pieval,explode=0.1,main="3D PIE OPINIONS")
pielabels<-
c("We hate\n pies","We oppose\n pies","We don't\n care","We just love pies")
pie3D.labels(bisectors,labels=pielabels)
}
\keyword{misc}
plotrix/man/categoryReshape.Rd 0000644 0001762 0000144 00000002046 14011145766 016151 0 ustar ligges users \name{categoryReshape}
\alias{categoryReshape}
\title{Convert object label/attribute label coding.}
\description{Convert object label/attribute label coding to an object by
attribute data frame.}
\usage{
categoryReshape(x)
}
\arguments{
\item{x}{A matrix or data frame with at least two columns.}
}
\details{
\samp{categoryReshape} attempts to convert the first two columns of its input
into a data frame in which rows represent objects and columns attributes. For
each object, a value of 1 indicates that the object has that attribute, and a
value of 0 that it does not. In set membership terms, a 1 indicates that the
object is a member of that set and a 0 that it is not.
}
\value{A data frame (see Details).}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{makeIntersectList}}
\examples{
ns<-sample(1:8,20,TRUE)
objects<-0
for(i in 1:length(ns)) objects<-c(objects,rep(i,ns[i]))
attributes<-"Z"
for(i in 1:length(ns)) attributes<-c(attributes,sample(LETTERS[1:8],ns[i]))
setdf<-data.frame(objects[-1],attributes[-1])
categoryReshape(setdf)
}
plotrix/man/std.error.Rd 0000755 0001762 0000144 00000000747 14011145766 014757 0 ustar ligges users \name{std.error}
\alias{std.error}
\title{Calculate standard error of the mean}
\description{
Calculates the standard error of the mean.
}
\usage{
std.error(x,na.rm)
}
\arguments{
\item{x}{A vector of numerical observations.}
\item{na.rm}{Dummy argument to match other functions.}
}
\details{
\samp{std.error} will accept a numeric vector.
}
\value{
The conventional standard error of the mean = sd(x)/sqrt(sum(!is.na(x)))
}
\author{Jim Lemon}
\seealso{\link{sd}}
\keyword{misc}
plotrix/man/bin.wind.records.Rd 0000755 0001762 0000144 00000002346 14011145766 016202 0 ustar ligges users \name{bin.wind.records}
\alias{bin.wind.records}
\title{Classify wind direction and speed records}
\description{Classifies wind direction and speed records into a matrix of
percentages of observations in speed and direction bins.}
\usage{
bin.wind.records(winddir,windspeed,ndir=8,radians=FALSE,
speed.breaks=c(0,10,20,30))
}
\arguments{
\item{winddir}{A vector of wind directions.}
\item{windspeed}{A vector of wind speeds corresponding to the above
directions.}
\item{ndir}{Number of direction bins in a compass circle.}
\item{radians}{Whether wind directions are in radians.}
\item{speed.breaks}{Minimum wind speed for each speed bin.}
}
\details{
\samp{bin.wind.records} bins a number of wind direction and speed
records into a matrix of percentages of observations that can be used to
display a cumulative wind rose with \samp{oz.windrose} The defaults are those
used by the Australian Bureau of Meteorology.
}
\value{
A matrix of percentages in which the rows represent wind speed categories and
the columns represent wind direction categories.
}
\author{Jim Lemon}
\seealso{\link{oz.windrose}}
\examples{
winddir<-sample(0:360,100,TRUE)
windspeed<-sample(0:40,100,TRUE)
bin.wind.records(winddir,windspeed)
}
\keyword{misc}
plotrix/man/stackpoly.Rd 0000755 0001762 0000144 00000006345 14011145766 015046 0 ustar ligges users \name{stackpoly}
\alias{stackpoly}
\title{
Display the columns of a matrix or data frame as stacked polygons
}
\description{
Plot one or more columns of numeric values as the top edges of polygons
instead of lines.
}
\usage{
stackpoly(x,y=NULL,main="",xlab="",ylab="",xat=NA,xaxlab=NA,
xlim=NA,ylim=NA,lty=1,lwd=1,border=NA,col=NULL,staxx=FALSE,stack=FALSE,
axis2=TRUE,axis4=TRUE,padj=0,...)
}
\arguments{
\item{x}{A numeric data frame or matrix with the \samp{x} values. If
\samp{y} is NULL, these will become the \samp{y} values and the \samp{x}
positions will be the integers from 1 to dim(x)[1].}
\item{y}{The \samp{y} values.}
\item{main}{The title for the plot.}
\item{xlab,ylab}{x and y axis labels for the plot.}
\item{xat}{Where to put the optional xaxlabs.}
\item{xaxlab}{Optional labels for the x positions.}
\item{xlim}{Optional x limits.}
\item{ylim}{Optional y limits.}
\item{lty}{Line type for the polygon borders.}
\item{lwd}{Line width for the polygon borders.}
\item{border}{Color for the polygon borders.}
\item{col}{Color to fill the polygons. If NULL, \samp{rainbow} will be
called to generate the colors. If NA, the polygons will not be filled.}
\item{staxx}{Whether to call \samp{staxlab} to stagger the x axis labels.}
\item{stack}{Whether to stack the successive values on top of each other.}
\item{axis2}{Whether to display the left ordinate on the plot.}
\item{axis4}{Whether to display the right ordinate on the plot.}
\item{padj}{Vertical justfication of the x axis labels, defaulting to "top".
Can be a vector with an element for each label.}
\item{...}{Additional arguments passed to \samp{plot}.}
}
\value{
nil
}
\details{
\samp{stackpoly} is similar to a line plot with the area under the
lines filled with color(s). Ideally, each successive set of y values
is greater than the values in the previous set so that the polygons
form a rising series of crests. If \samp{stack} is TRUE, this is not a
problem unless some values of \samp{x} are negative.
If \samp{x} or \samp{y} is a vector, not a matrix or list, the values will
be displayed as a "waterfall plot".
The options for \samp{axis2} and \samp{axis4} can be used to produce
panel plots. See the last example.
}
\author{Jim Lemon and Thomas Petzoldt (waterfall plot option) - thanks to
Phil Novack-Gottshall for the mismatched x and y fix}
\seealso{\link{polygon}}
\examples{
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)
stackpoly(testx,main="Test Stackpoly II",
xaxlab=c("One","Two","Three","Four","Five",
"Six","Seven","Eight","Nine","Ten"),border="black",
staxx=TRUE,stack=TRUE)
layout(matrix(1:2,nrow=1))
oldmar<-par(mar=c(5,4,4,0))
stackpoly(rev(sort(testx-mean(testx))),
main="Waterfall Plot (x-mean)",xat=seq(10,90,by=10),
xlab="Index",ylab="Value",lwd=3,col="green",border="black",
axis4=FALSE)
ylim<-par("usr")[3:4]
par(mar=c(5,0,4,4))
stackpoly(rev(sort((testx-mean(testx))/sd(as.vector(testx)))),
ylim=ylim,main="Waterfall Plot ((x-mean)/sd)",xat=seq(10,90,by=10),
xlab="Index",lwd=3,col="lightblue",border="black",axis2=FALSE)
par(oldmar)
}
\keyword{misc}
plotrix/man/box.heresy.Rd 0000644 0001762 0000144 00000006777 14011145766 015131 0 ustar ligges users \name{box.heresy}
\alias{box.heresy}
\title{Display a sort of box plot}
\usage{
box.heresy(x,y,uinner,linner,ulim,llim,boxwidth=NULL,
intervals=FALSE,arrow.cap=NULL,pch=22,main="",xlab="",ylab="",
xaxlab=NULL,col="white",do.first=NULL,...)
}
\arguments{
\item{x,y}{Vectors of numeric values representing measures of central tendency.}
\item{uinner,linner}{Vectors of numeric values representing "inner" measures of
dispersion.}
\item{ulim,llim}{Vectors of numeric values representing "outer" measures of
dispersion.}
\item{boxwidth}{Optional widths for the boxes.}
\item{intervals}{Whether the values for dispersion are intervals (TRUE) or
absolute limits (FALSE).}
\item{arrow.cap}{The width of the cap on the "whiskers" relative to the width
of the plot. Defaults to the same width as the outer box.}
\item{pch}{The symbol to be used to represent the measure(s) of central tendency
in the box.}
\item{main}{The title for the plot (i.e. \samp{main}).}
\item{xlab,ylab}{The x and y axis labels.}
\item{xaxlab}{Optional labels for the boxes.}
\item{col}{The fill colors for the "inner" rectangles.}
\item{do.first}{An expression that will be evaluated before anything is displayed.}
\item{...}{additional arguments passed to the \samp{dispersion} function.}
}
\description{
\samp{box.heresy} displays a box plot in which a symbol represents a measure of
central tendency, a surrounding box that represents an "inner" measure of dispersion
(e.g. standard error) and whiskers represent an "outer" measure of dispersion
(e.g. standard deviation). The function is pretty basic at this time and will
probably change a bit.
The argument "intervals" is particularly important, and can wreak
havoc on the resulting plot. The default of FALSE means that the
values passed to the inner and outer measures of dispersion are
absolute, not intervals away from the measure of central tendency.
Mixing absolute and relative values will always lead to errors and
typically a very strange looking plot. It is probably easiest to
calculate the absolute values before calling box.heresy. The first and
second examples show how intervals=FALSE and intervals=TRUE can be used.
One of the first changes is to allow varying box widths. The user can specify
the box widths as a vector of numeric values at least as long as the number
of boxes to be displayed. The usual reason for doing this is to display widths
that are proportional to the number of observations. A useful start is to pass
\samp{boxwidth} as the number of observations and let the function work it out.
}
\value{nil}
\author{Jim Lemon - thanks to Gianni Lavaredo for the suggestion}
\keyword{misc}
\seealso{\link{plot}, \link{boxplot}}
\examples{
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"))
y1outer<-
y<-runif(5)
ulim<-runif(5)
llim<-runif(5)
uinner<-ulim/2
linner<-llim/2
box.heresy(y,uinner=uinner,linner=linner,ulim=ulim,llim=llim,
intervals=TRUE,main="The heretical boxplot",
xlab="Number of observations",ylab="Value")
}
plotrix/man/intersectDiagram.Rd 0000755 0001762 0000144 00000017242 14011145766 016320 0 ustar ligges users \name{intersectDiagram}
\alias{intersectDiagram}
\title{Display set intersections}
\description{Display set intersections as rows of rectangles.}
\usage{
intersectDiagram(x,pct=FALSE,show.nulls=FALSE,xnames=NULL,sep="+",
mar=c(0,0,3,0),main="Intersection Diagram",cex=1,col=NULL,
minspacing=NA,all.intersections=FALSE,include=NULL,null.label="Non-set")
}
\arguments{
\item{x}{A list containing as many numeric vectors as there are sets. The
first vector contains the counts or percentages of the elements that are
only in one set, the next vector contains the counts or percentages of
elements that are in two sets and so on. A matrix of set membership
indicators or a two column matrix of object identifiers and attribute
identifiers can be passed - see Details.}
\item{pct}{Whether to display counts (FALSE) or percentages (TRUE) of the
number of entities.}
\item{show.nulls}{Whether to display the number of original objects that
are not members of any set. Any value that is not NA will become the
label for this category.}
\item{xnames}{Optional user supplied names for the set categories (see
Details).}
\item{sep}{The separator to use between category names (see Details).}
\item{mar}{The margins for the diagram. The margins that were in effect when
the function is called are restored.}
\item{main}{The title for the diagram.}
\item{col}{Colors for the sets (see Details).}
\item{cex}{Character expansion for the intersection labels.}
\item{minspacing}{The minimum spacing between the rectangles (see Details).}
\item{all.intersections}{Whether to display all intersections, even if empty
(Dangerous - see Detail).}
\item{include}{Which set identifiers to include in the diagram (see Details).}
\item{null.label}{The label for the non-set entities if displayed.}
}
\details{
\samp{intersectDiagram} displays rows of optionally colored rectangles that
represent the intersections of set memberships (attributes) of a set of objects.
The topmost row represents the intersections of the fewest sets, and
succeeding rows represent the intersections of more sets. If there were objects
in the original data set that were not members of any set, any percentages
calculated will reflect this. By setting \samp{show.nulls} to TRUE, the counts
or percentages of such objects will be displayed below the intersections over
an empty rectangle scaled to the count or percentage.
Important - If the \samp{all.intersections} argument is TRUE, all intersections
will be displayed, whether empty or not (see the example). This is mostly for
demonstration purposes, and if the number of sets is large, is likely to produce
a very messy diagram. Similarly, sets with large numbers of
intersections that are populated will require very large displays to be readable,
even if there are small numbers in the intersections. If you would like to see
this in action, pass the data frame \samp{setdf} in the \link{categoryReshape}
example to \samp{intersectDiagram} with \samp{all.intersections} TRUE.
\samp{intersectDiagram} does not attempt to display the set intersections as
a pattern of overlapping geometric figures, but rather the relative numbers of
objects sharing each intersection. More than three intersecting sets generally
produce a complex and difficult to interpret Venn diagram, and this provides an
alternative way to display the size of intersections between larger numbers
of sets.
\samp{intersectDiagram} now allows the user to display only part of the
set intersections, which is useful for analyzing very complex intersections.
This is controlled by the \samp{include} argument. This defaults to all sets or
attributes when \samp{include=NULL}. If one or more of the labels of the sets or
attributes is passed, only the intersections containing those labels will be
displayed. See examples 2 and 3 below.
Each set (attribute) is assigned a color if \samp{col} is not NA. \samp{rainbow}
is called if \samp{col} is NULL, otherwise the colors passed are used. For each
intersection, the colors representing the sets intersecting are included in
the rectangle.
The strings displayed on each rectangle are taken from the argument
\samp{xnames} unless that is NULL, then the \samp{names} of the intersectList
object passed as \samp{x} or returned from the call to \samp{makeIntersectList}.
If a matrix or data frame of set membership indicators is passed as \samp{x},
it will be passed to \link{makeIntersectList} for conversion. Each column must
represent a set, and the values in the columns must be 0 or 1, or FALSE or TRUE.
Similarly, if a matrix or data frame in which the first column is object
identifiers and the second column is attributes, this will be passed to
\samp{makeIntersectList}.
The spacing between the largest rectangles is controlled by \samp{minspacing}.
\samp{minspacing} is in units of object counts and defaults to 0.1 times the
largest number of objects in an intersection. When the number of objects in
different intersections at a given level varies widely, the labels of
intersections with few objects may overlap if they are wide relative to the
rectangle representing the number of objects. This can be corrected by
passing a \samp{minspacing} argument that will increase the space between
rectangles and/or decreasing the character size of the labels. If the labels
for each set are relatively long, setting \samp{namesep="\n"} may help. Note
that if a different separator is passed, that separator must be explicitly
passed in any subsequent calls using the same \samp{intersectList} object - see
examples 1 to 3 below.
}
\value{
Returns the intersectionList object invisibly.
}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{makeIntersectList}, \link{getIntersectList}, \link{categoryReshape}}
\examples{
# create a matrix where each row represents an element and
# a 1 (or TRUE) in each column indicates that the element is a member
# of that set.
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")
# then display only the intersections containing "Alc"
intersectDiagram(druglist,main="Patterns of drug use (Alcohol users only)",
sep="\n",include="alc")
# now display only the intersections containing "Amp"
intersectDiagram(druglist,main="Patterns of drug use (Speed users only)",
sep="\n",include="amp")
# then as percent with non.members, passing the initial matrix
intersectDiagram(druguse,pct=TRUE,show.nulls=TRUE)
# alter the data to have more multiple intersections
druguse[which(as.logical(druguse[,1]))[1:40],2]<-1
druguse[which(as.logical(druguse[,1]))[31:70],3]<-1
druguse[,4]<-sample(c(0,1),200,TRUE,prob=c(0.9,0.1))
intersectDiagram(druguse,main="Smaller font in labels",
col=c("gray20","gray40","gray60","gray80"),cex=0.8)
# transform the spacing - usually makes it too close, first try minspacing
intersectDiagram(druguse,col="gray",main="Minimum spacing = 30 cases",
minspacing=30)
# then try cex - may need both for large differences
intersectDiagram(druguse,main="Very boring single color",col="gray",cex=0.8)
# create a matrix with empty intersections
druguse<-matrix(c(sample(c(0,1),20,TRUE),
sample(c(0,1),20,TRUE),
sample(c(0,1),20,TRUE),
sample(c(0,1),20,TRUE)),ncol=4)
# show only the populated intersections
intersectDiagram(druguse,main="Display only populated intersections")
# show all intersections
intersectDiagram(druguse,main="Display empty intersections",all.intersections=TRUE)
}
plotrix/man/diamondplot.Rd 0000755 0001762 0000144 00000001766 14011145766 015351 0 ustar ligges users \name{diamondplot}
\alias{diamondplot}
\title{Plot multiple variables as polygons on a radial grid}
\usage{
diamondplot(x, bg=gray(0.6), col=rainbow,name="", ...)
}
\arguments{
\item{x}{A data frame containing numeric values that represent attributes
(possibly repeated observations) of data objects. See the example.}
\item{bg}{The background color for the plot.}
\item{col}{The colors for the polygons.}
\item{name}{The title for the plot (i.e. \samp{main}).}
\item{...}{additional arguments passed to \samp{plot}.}
}
\description{
\samp{diamondplot} displays a plot of polygons on a radial grid representing
the relationships between one or more attributes of data objects. For a slightly
different style of plot, see the "spiderweb plot" example in \samp{radial.plot}.
}
\value{nil}
\author{Elisa Biancotto}
\keyword{misc}
\seealso{\link{plot}, \link{radial.plot}}
\examples{
data(mtcars)
mysubset<-mtcars[substr(dimnames(mtcars)[[1]],1,1)=="M",c("mpg","hp","wt","disp")]
diamondplot(mysubset)
}
plotrix/man/thigmophobe.Rd 0000755 0001762 0000144 00000003012 14011145766 015326 0 ustar ligges users \name{thigmophobe}
\alias{thigmophobe}
\title{Find the direction away from the closest point}
\description{Find the direction away from the closest point}
\usage{
thigmophobe(x,y=NULL,names=seq_along(z),xlog=par("xlog"),ylog=par("ylog"),
usr=par("usr"),pin=par("pin"),eps=.Machine$double.eps,pi=base::pi)
}
\arguments{
\item{x,y}{Numeric data vectors. Typically the x/y coordinates of
plotted points. If arrays are passed, they will be silently coerced to
numeric vectors.}
\item{names}{Names for the vector of directions.}
\item{xlog,ylog}{Flags for logarithmic axes. See Note.}
\item{usr}{The extent of the plot in user units.}
\item{pin}{Extent of the plot in inches.}
\item{eps}{smallest number that can be represented on the system.}
\item{pi}{value of pi.}
}
\details{
\samp{thigmophobe} returns the direction (as 1|2|3|4 - see pos= in
\samp{text}) away from the nearest point to each of the points
described by \samp{x} and \samp{y}.
}
\note{
\samp{thigmophobe} is typically used to get the offsets to automatically
place labels on a scatterplot or similar using \samp{thigmophobe.labels}
to avoid overlapping labels. The name means "one who fears being touched".
The \samp{plot.span}, \samp{xlog} and \samp{ylog} arguments were added to
allow \samp{thigmophobe} to be used outside of base graphics.
}
\value{
A vector of directions away from the point nearest to each point.
}
\keyword{misc}
\author{Bill Venables}
\seealso{\link{thigmophobe.labels}}
\examples{
x<-rnorm(10)
y<-rnorm(10)
thigmophobe(x,y)
}
plotrix/man/sizeplot.Rd 0000755 0001762 0000144 00000002512 14011145766 014676 0 ustar ligges users \name{sizeplot}
\alias{sizeplot}
\title{Plot with repeated symbols by size}
\description{
Plots a set of (x,y) data with repeated points denoted by larger
symbol sizes
}
\usage{
sizeplot(x, y, scale=1, pow=0.5, powscale=TRUE, size=c(1,4), add=FALSE, ...)
}
\arguments{
\item{x}{x coordinates of data}
\item{y}{y coordinates of data}
\item{scale}{scaling factor for size of symbols}
\item{pow}{power exponent for size of symbols}
\item{powscale}{(logical) use power scaling for symbol size?}
\item{size}{(numeric vector) min and max size for scaling, if powscale=FALSE}
\item{add}{(logical) add to an existing plot?}
\item{\dots}{other arguments to \samp{plot()} or \samp{points()}}
}
\details{
Most useful for plotting (e.g.) discrete data, where repeats are
likely. If all points are repeated equally, gives a warning. The
size of a point is given by \eqn{scale*n^pow}, where n is the number of
repeats, if powscale is TRUE, or it is scaled between size[1] and size[2],
if powscale is FALSE.
}
\value{
A plot is produced on the current device, or points are added to the
current plot if \samp{add=TRUE}.
}
\author{Ben Bolker}
\seealso{\link{symbols}}
\examples{
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)
sizeplot(x,y,pch=2)
}
\keyword{hplot}
plotrix/man/barNest.Rd 0000755 0001762 0000144 00000021521 14011145766 014424 0 ustar ligges users \name{barNest}
\alias{barNest}
\title{Display a nested breakdown of numeric values}
\description{Breaks down the elements of a data frame by one or more
categorical elements and displays the breakdown as a bar plot.}
\usage{
barNest(formula=NULL,data=NULL,FUN=c("mean","sd","sd","valid.n"),ylim=NULL,
main="",xlab="",ylab="",shrink=0.1,errbars=FALSE,col=NA,
labelcex=1,lineht=NULL,showall=TRUE,Nwidths=FALSE,barlabels=NULL,
showlabels=TRUE,mar=NULL,arrow.cap=NULL,trueval=TRUE)
}
\arguments{
\item{formula}{A formula with a numeric element of a data frame on the left and
one or more categorical elements on the right.}
\item{data}{A data frame containing the elements in \samp{formula}.}
\item{FUN}{The functions to apply to x.}
\item{ylim}{Optional y limits for the plot, usually necessary for counts.}
\item{main}{Title for the plot.}
\item{xlab,ylab}{Axis labels for the plot. The x axis label is typically blank}
\item{shrink}{The proportion to shrink the width of the bars at each level.}
\item{errbars}{Whether to display error bars on the lowest level of breakdown.}
\item{col}{The colors to use to fill the bars. See Details.}
\item{labelcex}{Character size for the group labels.}
\item{lineht}{The height of a line of text in the lower margin of the plot in user
units. This will be calculated by the function if a value is not passed.}
\item{showall}{Whether to display bars for the entire breakdown.}
\item{Nwidths}{Whether to scale the widths of the bars to the number of
observations.}
\item{barlabels}{Optional group labels that may be useful if the factors used to
break down the numeric variable are fairly long strings.}
\item{showlabels}{Whether to display the labels below the bars.}
\item{mar}{If not NULL, a four element vector to set the plot margins. If new
margins are set, the user must reset the margins after the function exits.}
\item{arrow.cap}{The width of the "cap" on error bars in user units,
calculated on the basis of the number of bars in the final breakdown if NA.}
\item{trueval}{If this is not NA, the call to \samp{brkdnNest} will return the
proportions of the response variable that are equal to \samp{trueval}.
See Details.}
}
\value{The summary list produced by brkdnNest.}
\details{
\samp{barNest} displays a bar plot illustrating the hierarchic breakdown of
the elements of a data frame. The breakdown is performed by \samp{brkdnNest}
and the actual display is performed by \samp{drawNestedBars}. The heights of
the bars will be proportional to the values returned by the first function in
\samp{FUN}. If \samp{showall} is TRUE, the entire nested breakdown will be
displayed. This can be useful in visualizing the relationship between groups
and subgroups in a compact format.
\samp{barNest} assumes that there will be four breakdowns in the list
returned by \samp{brkdnNest} in the order summary measure, upper dispersion
value, lower dispersion value and number of valid observations. If
\samp{Nwidths=FALSE}, it may work with only three and if \samp{errbars=FALSE}
as well, it may work with only one.
If \samp{Nwidths=TRUE}, the bar widths will be scaled to the relative number
of observations per group. When the numbers of observations are very different,
the labels for those bars with small numbers of observations will probably
overlap.
A number of functions can be passed in the \samp{FUN} argument. Three
functions, \samp{propbrk}, \samp{sumbrk} and \samp{valid.n} will work as
summary measures, giving proportions or sums of particular values of a
discrete variable and counts in each group and subgroup respectively.
Binomial confidence limits can be added to the proportions returned by
\samp{propbrk} with \samp{binciWl} and \samp{binciWu} as in the second last
example. If \samp{valid.n} is the first element of \samp{FUN}, the "overall"
bar and label will be suppressed, as they are not informative. It is up to
the user to decide whether any "error bars" displayed are meaningful.
The colors of the bars are determined by \samp{col}. If \samp{showall} is
FALSE, the user only need pass a vector of colors, usually the same length
as the number of categories in the final (last on the right side) element in
the formula. If \samp{showall} is TRUE and the user wants to color all of the
bars, a list with as many elements as there are levels in the breakdown
should be passed. Each element should be a vector of colors, again usually
the same length as the number of categories. As the categorical variables are
likely to be factors, it is important to remember that the colors must be in
the correct order for the levels of the factors. When the levels are not in
the default alphanumeric order, it is quite easy to get this wrong. As a
\samp{barNest} plot with more than a few factors and levels in each factor is
quite dense, easily distinguished colors for each level of the breakdown may
be preferable. As with some other plots, trying to cram too much information
into a single illustration may not work well.
}
\author{Jim Lemon and Ofir Levy}
\references{
Lemon, J. & Levy, O. (2011) barNest: Illustrating nested summary measures.
Statistical Computing and Graphics Newsletter of the American Statistical
Association, 21(2): 5-10.
}
\seealso{\link{brkdnNest}, \link{drawNestedBars}, superbarplot(UsingR)}
\examples{
# recreate the Titanic data frame and show the three way breakdown
titanic<-data.frame(
class=c(rep("1st",325),rep("2nd",285),rep("3rd",706),rep("Crew",885)),
age=c(rep("Adult",319),rep("Child",6),rep("Adult",261),rep("Child",24),
rep("Adult",627),rep("Child",79),rep("Adult",885)),
sex=c(rep("M",175),rep("F",144),rep("M",5),rep("F",1),
rep("M",168),rep("F",93),rep("M",11),rep("F",13),
rep("M",462),rep("F",165),rep("M",48),rep("F",31),
rep("M",862),rep("F",23)),
survived=c(rep("Yes",57),rep("No",118),rep("Yes",140),rep("No",4),rep("Yes",6),
rep("Yes",14),rep("No",154),rep("Yes",80),rep("No",13),rep("Yes",24),
rep("Yes",75),rep("No",387),rep("Yes",76),rep("No",89),
rep("Yes",13),rep("No",35),rep("Yes",14),rep("No",17),
rep("Yes",192),rep("No",670),rep("Yes",20),rep("No",3)))
require(plotrix)
titanic.colors<-list("gray90",c("#0000ff","#7700ee","#aa00cc","#dd00aa"),
c("#ddcc00","#ee9900"),c("pink","lightblue"))
barNest(survived~class+age+sex,titanic,col=titanic.colors,showall=TRUE,
main="Titanic survival by class, age and sex",ylab="Proportion surviving",
FUN=c("propbrk","binciWu","binciWl","valid.n"),shrink=0.15,trueval="Yes")
barNest(survived~class+age+sex,titanic,col=titanic.colors,showall=TRUE,
main="Titanic survival by class, age and sex (scaled bar widths)",
ylab="Proportion surviving",FUN=c("propbrk","binciWu","binciWl","valid.n"),
shrink=0.15,trueval="Yes",Nwidths=TRUE)
# now show the actual numbers of passengers
barNest(survived~class+age+sex,titanic,col=titanic.colors,showall=TRUE,
main="Titanic passengers and crew by class, age and sex",
ylab="Number",FUN="valid.n",shrink=0.15)
# to see this properly displayed, start a wide plot window
# x11(width=10)
test.df<-data.frame(Age=rnorm(100,35,10),
Sex=sample(c("Male","Female"),100,TRUE),
Marital=sample(c("Div","Mar","Sing","Wid"),100,TRUE),
Employ=sample(c("FT","PT","Un"),100,TRUE))
test.col<-list(Overall="gray",Sex=c("pink","lightblue"),
Marital=c("mediumpurple","orange","tan","lightgreen"),
Employ=c("#1affd8","#caeecc","#ff90d0"))
barNest(formula=Age~Sex+Marital+Employ,data=test.df,ylab="Mean age (years)",
main="Mean age by subgroups",errbars=TRUE,col=test.col)
barNest(formula=Age~Sex+Marital+Employ,data=test.df,ylab="Mean age (years)",
main="Mean age by subgroups (widths scaled to Ns)",errbars=TRUE,col=test.col,
Nwidths=TRUE)
# set up functions for 20th and 80th percentiles
q20<-function(x,na.rm=TRUE) return(quantile(x,probs=0.2,na.rm=TRUE))
q80<-function(x,na.rm=TRUE) return(quantile(x,probs=0.8,na.rm=TRUE))
# show the asymmetric dispersion measures
barNest(formula=Age~Sex+Marital+Employ,data=test.df,ylab="Mean age (years)",
main="Use median and quantiles for dispersion",
FUN=c("median","q80","q20","valid.n"),
errbars=TRUE,col=test.col)
barNest(formula=Employ~Sex+Marital,data=test.df,ylab="Proportion unemployed",
main="Proportion unemployed by sex and marital status",
FUN=c("propbrk","binciWu","binciWl","valid.n"),
errbars=TRUE,col=test.col,trueval="Un")
barNest(formula=Employ~Sex+Marital,data=test.df,ylab="Proportion unemployed",
main="Proportion unemployed by sex and marital status (scaled bar widths)",
FUN=c("propbrk","binciWu","binciWl","valid.n"),
errbars=TRUE,col=test.col,trueval="Un",Nwidths=TRUE)
barNest(formula=Age~Sex+Marital+Employ,data=test.df,ylab="Counts",
main="Show the counts in subgroups (final level only)",FUN="valid.n",
col=test.col,showall=FALSE,ylim=c(0,10))
barNest(formula=Age~Sex+Marital+Employ,data=test.df,ylab="Counts",
main="Show all the counts in subgroups",FUN="valid.n",mar=c(5,5,4,2),
col=test.col)
}
\keyword{misc}
plotrix/man/draw.radial.line.Rd 0000644 0001762 0000144 00000004311 14011145766 016137 0 ustar ligges users \name{draw.radial.line}
\alias{draw.radial.line}
\title{Draw a radial line}
\description{Draws a line radiating from a specified center, optionally
expanding the line width as a function of distance from center.}
\usage{
draw.radial.line(start, end, center=c(0, 0), angle=0, deg=NA,
expand=FALSE, col=NA, lwd=NA, ...)
}
\arguments{
\item{start}{Distance from center of circular area to start of line in
x/y user units.}
\item{end}{Distance from center of circular area to end of line in x/y
user units.}
\item{center}{The center of the circular area in x/y user units.}
\item{angle}{The angular position of the line in radians.}
\item{deg}{The angular position of the line in degrees
(takes precedence if not NA).}
\item{expand}{TRUE to expand line width in proportion to distance from
center.}
\item{col}{The color of the line, NA for par("col").}
\item{lwd}{The width of the line in device-specific units,
NA for par("lwd").}
\item{...}{Arguments passed to 'lines' (expand=FALSE) or 'polygon'
(expand=TRUE).}
}
\value{nil}
\details{
If the user passes a value for 'deg', this overrides any value passed
to 'angle'.
If 'expand' is FALSE, the line width is constant (as specified by par("lwd").
If 'expand' is TRUE, the line width is equal to the lwd value at distance
'end' and contracts as it moves towards 'start'. When expand is 'TRUE',
lty is ignored.
}
\author{Ted Toal}
\seealso{\link{lines}, link{draw.arc}}
\examples{
plot(0, xlim=c(1,5), ylim=c(1,5), main="Test of radial lines", xlab="", ylab="", type="n")
points(3, 3, pch=20)
draw.radial.line(1, 2, center=c(3,3))
draw.radial.line(1, 2, center=c(3,3), angle=pi/4)
draw.radial.line(1, 2, center=c(3,3), angle=pi/4+0.1, col="blue", lwd=4, lty=3)
draw.radial.line(0.2, 1.2, center=c(3,3), deg=120, col="red", lwd=10)
draw.radial.line(0.2, 1.2, center=c(3,3), deg=145, col="purple", lwd=10, lend=1)
draw.radial.line(0.5, 2, center=c(3,3), deg=225, expand=TRUE, col="gold")
draw.radial.line(0.7, 1.4, center=c(3,3), deg=180, expand=TRUE, col="orange", lwd=30)
draw.radial.line(0.5, 1.5, center=c(3,3), deg=235, expand=TRUE, lwd=5, col="brown")
draw.radial.line(0.1, 1.5, center=c(3,3), deg=325, expand=TRUE, lwd=5, col="green")
}
\keyword{misc}
plotrix/man/multsymbolbox.Rd 0000755 0001762 0000144 00000001713 14011145766 015747 0 ustar ligges users \name{multsymbolbox}
\alias{multsymbolbox}
\title{Draw boxes filled with symbols}
\description{
Draw boxes on the current figure filled with symbols representing
individual counts.
}
\usage{
multsymbolbox(x1,y1,x2,y2,tot,relw=0.8,fg=par("fg"),bg=par("bg"),
box=TRUE,debug=FALSE,...)
}
\arguments{
\item{x1}{numeric vector: left sides of boxes}
\item{y1}{numeric vector: bottom sides of boxes}
\item{x2}{numeric vector: right sides of boxes}
\item{y2}{numeric vector: top sides of boxes}
\item{tot}{numeric vector: total numbers of symbols to put in each box}
\item{relw}{relative width (relative to height) of symbols}n
\item{fg}{foreground color(s)}
\item{bg}{background color(s)}
\item{box}{(logical) draw box borders?}
\item{debug}{debug output?}
\item{\dots}{additional arguments to polygon() for drawing boxes}
}
\value{
none
}
\author{Ben Bolker}
\examples{
plot(1:10,1:10,type="n")
multsymbolbox(c(2,4),5,c(4,5),8,tot=c(10,8))
}
\keyword{aplot}
plotrix/man/soil.texture.uk.Rd 0000755 0001762 0000144 00000010031 14011145766 016103 0 ustar ligges users \name{soil.texture.uk}
\alias{soil.texture.uk}
\title{Soil texture triangle plot using UK conventions}
\description{
Display a UK style soil texture triangle with optional grid, labels and
soil texture points.
}
\usage{
soil.texture.uk(soiltexture = NULL, main = "",at = seq(0.1, 0.9, by = 0.1),
axis.labels = c("percent sand", "percent silt", "percent clay"),
tick.labels = list(l = seq(10, 90, by = 10), r = seq(10, 90, by = 10),
b = seq(10, 90, by = 10)), show.names = TRUE,
show.lines = TRUE, col.names = "gray", bg.names = par("bg"),
show.grid = FALSE, col.axis = "black", col.lines = "gray",
col.grid = "gray", lty.grid = 3, show.legend = FALSE, label.points = FALSE,
point.labels = NULL, col.symbols = "black", pch = par("pch"),
h1 = NA, h3 = NA, t1 = NA, t3 = NA, lwduk = 2, xpos = NA, ypos = NA,
snames = NA, cexuk = 1.1, ...)
}
\arguments{
\item{soiltexture}{Matrix of soil textures where each row is a
soil sample and three columns containing the percentages of the
components sand, silt and clay in the range 0 to 100.}
\item{main}{The title of the soil texture plot. Defaults to nothing.}
\item{at}{Positions on the three axes where ticks will be drawn.}
\item{axis.labels}{Labels for the axes.}
\item{tick.labels}{The tick labels for the three axes.}
\item{show.names}{Logical - whether to show the names of different
soil types within the soil triangle.}
\item{show.lines}{Logical - whether to show the boundaries of the
different soil types within the soil triangle.}
\item{col.names}{Color of the soil names. Defaults to gray.}
\item{bg.names}{Color to use when drawing a blank patch for the names
of soil types.}
\item{show.grid}{Logical - whether to show grid lines at each 10%
level of each soil component.}
\item{col.axis}{Color of the triangular axes, ticks and labels.}
\item{col.lines}{Color of the boundary lines. Defaults to gray.}
\item{col.grid}{Color of the grid lines. Defaults to gray.}
\item{lty.grid}{Type of line for the grid. Defaults to dashed.}
\item{show.legend}{Logical - whether to display a legend.}
\item{label.points}{Logical - whether to call
\link{thigmophobe.labels} to label the points.}
\item{point.labels}{Optional labels for the points or legend.}
\item{col.symbols}{Color of the symbols representing each value.}
\item{pch}{Symbols to use in plotting values.}
\item{h1,h3,t1,t3}{Points used in drawing boundaries for soil types.}
\item{lwduk}{Line width for the boundaries}
\item{xpos,ypos}{Positions for the soil type labels.}
\item{snames}{Soil type labels.}
\item{cexuk}{Character expansion for the soil type labels.}
\item{...}{Additional arguments passed to \link{triax.points}
and then \samp{points}.}
}
\details{
\samp{soil.texture.uk} displays a triangular plot area on which soil
textures defined as proportions of sand, silt and clay can be plotted.
It is similar to the \samp{soil.texture} function but uses the UK
display conventions.
}
\value{If \samp{soiltexture} was included, a list of the \samp{x,y}
positions of the soil types plotted. If not, nil.
}
\author{Julian Stander}
\seealso{\link{triax.plot}}
\examples{
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")
}
\keyword{misc}
plotrix/man/radial.pie.Rd 0000644 0001762 0000144 00000011656 14011145766 015043 0 ustar ligges users \name{radial.pie}
\alias{radial.pie}
\title{
Plot sectors/annuli on a circular grid of 0 to 2*pi radians
}
\description{
Plot numeric values as sectors with optional annuli on a circular field in the
directions defined by angles in radians.
}
\usage{
radial.pie(radial.extents,sector.edges=NULL,
sector.colors=NULL,cs1=c(0,1),cs2=c(0,1),cs3=c(0,1),
alpha=1,labels=NA,label.pos=NULL,radlab=FALSE,start=0,
clockwise=FALSE,label.prop=1.1,radial.lim=NULL,main="",xlab="",ylab="",
mar=c(2,2,3,2),show.grid=TRUE,show.grid.labels=4,show.radial.grid=TRUE,
grid.col="gray",grid.bg="transparent",grid.unit=NULL,
radial.labels=NULL,boxed.radial=TRUE,add=FALSE,...)
}
\arguments{
\item{radial.extents}{A numeric data vector or list. If \samp{radial.extents}
is a list, the elements of the list will be considered separate data vectors.}
\item{sector.edges}{A numeric vector of positions in radians.
These are interpreted as beginning at the right (0 radians) and moving
counterclockwise unless \samp{clockwise} is TRUE.}
\item{sector.colors}{Optional colors for the sectors and annuli. Defaults to
\samp{rainbow(nsectors)} with fading outward if annuli are specified.}
\item{cs1, cs2, cs3, alpha}{Color scaling arguments - see \link{color.scale}.}
\item{labels}{Character strings to be placed at the outer ends of
the lines. If set to NA, will suppress printing of labels,
but if missing, the radial positions will be used.}
\item{label.pos}{The positions of the labels around the plot in radians.}
\item{radlab}{Whether to rotate the outer labels to a radial orientation.}
\item{start}{Where to place the starting (zero) point. Defaults to the
3 o'clock position.}
\item{clockwise}{Whether to interpret positive positions as clockwise from
the starting point. The default is counterclockwise.}
\item{label.prop}{The label position radius as a proportion of the
maximum line length.}
\item{radial.lim}{The inner and outer radial limits for the plot. Defaults
to the range of radial.extents, although zero to \samp{max(radial.extents)}
is often what is wanted.}
\item{main}{The title for the plot.}
\item{xlab,ylab}{Normally x and y axis labels are suppressed.}
\item{mar}{Margins for the plot. Allows the user to leave space for
legends, long labels, etc.}
\item{show.grid}{Logical - whether to draw a circular grid.}
\item{show.grid.labels}{Whether and where to display labels for the grid
- see Details.}
\item{show.radial.grid}{Whether to draw radial lines to the plot labels.}
\item{grid.col}{Color of the circular grid.}
\item{grid.bg}{Fill color of above.}
\item{grid.unit}{Optional unit description for the grid.}
\item{radial.labels}{Optional labels for the radial grid. The default is
the values of radial.lim.}
\item{boxed.radial}{Whether to use boxed.labels or text for radial labels.}
\item{add}{Whether to add one or more series to an existing plot.}
\item{...}{Additional arguments are passed to \samp{plot}.}
}
\value{
The \samp{par} values that are changed in the function
as they were at the time \samp{radial.pie} was called.
}
\details{
\samp{radial.pie} displays a plot of radial sectors with optional annular
sections centered at the midpoint of the plot frame, the lengths corresponding
to the numeric magnitudes of \samp{radial.extents}.
If more series are added to an existing plot,
\samp{radial.pie} will try to maintain the current plot parameters. However,
it seems unlikely that adding series would be sensible in \samp{radial.pie}.
This argument may be dropped if it proves useless.
The size of the labels on the outside of the plot can be adjusted by
setting \samp{par(cex.axis=)} and that of the labels inside by setting
\samp{par(cex.lab=)}. If \samp{radlab} is TRUE, the labels will be rotated
to a radial alignment. This may help when there are many values and labels.
If some labels are still crowded, try running \samp{label.pos} through the
\samp{spreadout} function. If the \samp{show.grid.labels} argument is a number
from 1 to 4, the labels will be placed along a horizontal or vertical radius.
The numbers represent the same positions as in \samp{axis}, with the default
(4) on the right. To suppress these labels, pass zero or FALSE.
\samp{radial.pie} works somewhat differently from the \samp{radial.plot}
family and is still under development. I have released it in order to get
feedback to improve both the design and the programming. If successful, I
hope to merge the code with the \samp{radial.plot} function.
}
\author{Jim Lemon - thanks to Patrick Jemison for asking for it.}
\seealso{\link{radial.plot}}
\examples{
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))
oldpar<-radial.pie(pie1,labels=LETTERS[1:9])
radial.pie(pie2,labels=letters[2:10])
radial.pie(pie3,labels=1:36)
radial.pie(pie4,labels=1:36)
# restore the par values
par(oldpar)
}
\keyword{misc}
plotrix/man/dendroPlot.Rd 0000644 0001762 0000144 00000006176 14011145766 015146 0 ustar ligges users \name{dendroPlot}
\alias{dendroPlot}
\title{ Display distributions as dendrites }
\description{
Display the distributions of one or more sets of points as branching
(dendritic) clusters.
}
\usage{
dendroPlot(x,breaks=list(10,10,10),pch=1,col=par("fg"),cex=1,nudge=NA,
setlabels=NA,...)
}
\arguments{
\item{x}{A list or data frame of numeric or factor or character
columns.}
\item{breaks}{A list of cutpoints to transform numeric values into factors
(see \link{cut}). Must be at least one number >= 2.}
\item{pch}{Symbol(s) to use in plotting the values.}
\item{col}{Color(s) for the symbols.}
\item{cex}{Size of the symbol(s) to use in plotting.}
\item{nudge}{The amount to set each consecutive value in a category away from
the center of the dendrite.}
\item{setlabels}{Labels to place along the abcissa to identify the sets.}
\item{...}{Other arguments passed to plot.}
}
\details{
\samp{dendroPlot} displays the distributions of categorical values as stacks
of "branches". The lengths of the branches show the number of values in each
category, rather like the opposed bars in a pyramid plot, except that there
is no separation of groups. The distribution of numeric values can also be
displayed by passing a set of breakpoints to categorize the values. The
breakpoints will usually be equidistant, but unevenly spaced breakpoints can
be passed. If an element of \samp{x} is numeric, the values of the
corresponding \samp{x} element will be used to place the points, but the
branches will be defined as the categories formed by applying the breaks to
those numeric values.
Note that in the first example, the breakpoints for the first and third elements
are used to define the ten branches for each. The second element of \samp{x}
is already categorical, so the breakpoints are ignored. When comparing
distributions with very different ranges it may be necessary to adjust the
breakpoints to get a satisfactory result.
Each successive point in a category is \samp{nudge}d away from the center
of the dendrite. If \samp{nudge} has more than one value, the points will be
nudged up and down for categorical variables to enable closer packing. The
second value of \samp{nudge} is ignored for numeric variables. The aspect
ratio of the plot, the character expansion and the nudging will have to be
adjusted to give the best point spacing for most dendroPlots.
}
\note{The \samp{ehplot} function is a much more versatile instantiation of this
type of plot. \samp{dendroPlot} has been retained as there are currently a few
differences that some users may find valuable. However, it is not impossible
that \samp{dendroPlot} will disappear in the future. Another very useful version
of this type of plot is \samp{beeswarm} in the \pkg{beeswarm} package.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{ehplot}}
\examples{
x<-list(runif(90,1,3),factor(sample(LETTERS[1:10],100,TRUE)),rnorm(80,mean=5))
dendroPlot(x,xlab="Groups",ylab="Value of x",main="Test dendroPlot I")
# now apply a nudge factor and different breaks
dendroPlot(x,breaks=list(8,10,10),nudge=c(0.05,0.1),
xlab="Groups",ylab="Value of x",main="Test dendroPlot II")
}
\keyword{misc}
plotrix/man/fullaxis.Rd 0000755 0001762 0000144 00000004030 14011145766 014651 0 ustar ligges users \name{fullaxis}
\alias{fullaxis}
\title{Add an axis with a line to the edge of the plot}
\description{
As \samp{axis}, but draws a "box" line in the same color as the axis.
}
\usage{
fullaxis(side=1,at=NULL,labels=TRUE,line=NA,pos=NA,outer=FALSE,
font=NA,lty="solid",lwd=1,lwd.ticks=lwd,col=NULL,col.ticks=NULL,
hadj=NA,padj=NA,...)
}
\arguments{
\item{side}{The side of the plot to draw the axis}
\item{at}{Optional positions in user units for the tick marks.}
\item{labels}{Optional labels for the tick marks.}
\item{line}{Optional line into the margin.}
\item{pos}{Optional position in user units for the axis. Defaults to the edge.}
\item{outer}{Whether to use the outer margin as for \samp{axis}.}
\item{font}{Font for the labels.}
\item{lty}{Line type.}
\item{lwd}{Line width for the axis.}
\item{lwd.ticks}{Line width for the ticks.}
\item{col}{color for the axis and tick marks. See Details for label color.}
\item{col.ticks}{Color for the tick marks if different from the axis.}
\item{hadj,padj}{Justification for the labels. See \samp{axis}.}
\item{...}{Further arguments passed to \samp{axis}.}
}
\details{
\samp{fullaxis} draws a line to the edges of the plot and then calls
\samp{axis} to draw an axis. \samp{fullaxis} is mainly useful for drawing a
colored axis on a boxed plot. In order to get the tick labels the same color as
the axis and ticks, pass the \samp{col.axis} argument (as part of ...) as well
as \samp{col}. See the example for some useful tips.
}
\value{
The positions of the tick marks in user units.
}
\author{ Jim Lemon }
\seealso{ \link{axis}}
\examples{
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)
# add a top line to complete the "box"
xylim<-par("usr")
segments(xylim[1],xylim[4],xylim[2],xylim[4])
}
\keyword{misc}
plotrix/man/emptyspace.Rd 0000755 0001762 0000144 00000002201 14011145766 015172 0 ustar ligges users \name{emptyspace}
\alias{emptyspace}
\title{ Find an empty space on a plot }
\description{
Try to find the largest empty rectangle on a plot.
}
\usage{
emptyspace(x,y=NULL)
}
\arguments{
\item{x,y}{x and y positions of the points on the plot.}
}
\details{
\samp{emptyspace} searches the pairs of points on the plot to find
the largest rectangular space within which none of the points lie.
It does not guarantee that the space will be large enough to fit a
legend or text.
Two alternatives are the \samp{largest.empty} function in the
\pkg{Hmisc} package and the \samp{maxEmptyRect} function. While
\samp{maxEmptyRect} will generally outperform \samp{emptyspace},
\samp{emptyspace} will sometimes find a slightly smaller, but
"squarer" rectangle.
}
\value{
The \samp{x} and \samp{y} coordinates of the center of the rectangle
found.
}
\author{Ray Brownrigg}
\examples{
x<-rnorm(100)
y<-rnorm(100)
plot(x,y,main="Find the empty space",xlab="X",ylab="Y")
es<-emptyspace(x,y)
# use a transparent background so that any overplotted points are shown
boxed.labels(es,labels="Here is the\nempty space",bg="transparent")
}
\keyword{misc}
plotrix/man/vectorField.Rd 0000755 0001762 0000144 00000004615 14011145766 015301 0 ustar ligges users \name{vectorField}
\alias{vectorField}
\title{Display magnitude/direction vectors}
\description{Display magnitude/direction vectors as arrows on an existing plot.}
\usage{
vectorField(u,v,xpos=NA,ypos=NA,scale=1,headspan=0.1,
vecspec=c("lonlat","rad","deg"),col=par("fg"))
}
\arguments{
\item{u,v}{x (longitude) and y (latitude) offsets OR
orientation and magnitude in either radians or degrees. See details.}
\item{xpos,ypos}{The centers of the vectors in user units.}
\item{scale}{The proportion of each cell that the maximal vector will fill.
See details.}
\item{headspan}{The extent of the heads of the arrows as a proportion of
cell size.}
\item{vecspec}{How the vectors are described. See details}
\item{col}{Color(s) for the arrows.}
}
\value{ nil }
\details{
\samp{vectorField} displays arrows on an existing plot. Each arrow is specified
by a position on the plot \samp{xpos,ypos} and either x/y offsets or
orientation and magnitude. The default is x/y offsets, and the user must
specify whether radians or degrees are used if the orientation/magnitude option
is used.
If the first four arguments are matrices, there must be no missing values. If
these arguments are vectors, the calculation of the scaling of the magnitudes
and length of the arrowheads may be slightly different.
}
\author{Jim Lemon (original code by Robin Hankin and Brian Ripley)}
\seealso{\link{arrows}}
\examples{
\dontrun{
# this requires the maps package, and just wouldn't pass check
require(maps)
map("world",xlim=c(110,155),ylim=c(-40,-10))
par(xpd=TRUE)
text(132,-5,"Approximate magnetic deviation - Australia",cex=1.5)
par(xpd=FALSE)
long<-rep(seq(117.5,152.5,by=5),6)
lat<-rep(c(-12.5,-17.5,-22.5,-27.5,-32.5,-37.5),each=8)
# just show the direction, don't have a magnitude difference
mag<-rep(1,48)
devdeg<-c(110,98,85,65,65,65,65,65,
115,100,90,80,72,66,63,55,
130,100,90,82,72,67,62,54,
122,111,95,86,70,67,56,48,
118,116,110,87,74,68,62,45,
128,115,107,90,78,66,53,45)
vectorField(devdeg,mag,long,lat,scale=0.7,vecspec="deg")
}
# do a magnitude/direction plot with radians
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)
}
\keyword{misc}
plotrix/man/taylor.diagram.Rd 0000755 0001762 0000144 00000007773 14011145766 015760 0 ustar ligges users \name{taylor.diagram}
\alias{taylor.diagram}
\title{ Taylor diagram }
\description{ Display a Taylor diagram}
\usage{
taylor.diagram(ref,model,add=FALSE,col="red",pch=19,pos.cor=TRUE,
xlab="Standard deviation",ylab="",main="Taylor Diagram",
show.gamma=TRUE,ngamma=3,gamma.col=8,sd.arcs=0,
ref.sd=FALSE,sd.method="sample",grad.corr.lines=c(0.2,0.4,0.6,0.8,0.9),
pcex=1,cex.axis=1,normalize=FALSE,mar=c(4,3,4,3),...)
}
\arguments{
\item{ref}{numeric vector - the reference values.}
\item{model}{numeric vector - the predicted model values.}
\item{add}{whether to draw the diagram or just add a point.}
\item{col}{the color for the points displayed.}
\item{pch}{the type of point to display.}
\item{pos.cor}{whether to display only positive (\samp{TRUE}) or all
values of correlation (\samp{FALSE}).}
\item{xlab,ylab}{plot axis labels.}
\item{main}{title for the plot.}
\item{show.gamma}{whether to display standard deviation arcs around
the reference point (only for \samp{pos.cor=TRUE}).}
\item{ngamma}{the number of gammas to display (default=3).}
\item{gamma.col}{color to use for the gamma arcs (only with pos.cor=TRUE).}
\item{sd.arcs}{whether to display arcs along the standard deviation axes
(see Details).}
\item{ref.sd}{whether to display the arc representing the reference
standard deviation.}
\item{sd.method}{Whether to use the sample or estimated population SD.}
\item{grad.corr.lines}{the values for the radial lines for correlation
values (see Details).}
\item{pcex}{character expansion for the plotted points.}
\item{cex.axis}{character expansion for the axis text.}
\item{normalize}{whether to normalize the models so that the reference
has a standard deviation of 1.}
\item{mar}{margins - only applies to the \samp{pos.cor=TRUE} plot.}
\item{...}{Additional arguments passed to \samp{plot}.}
}
\details{
The Taylor diagram is used to display the quality of model predictions
against the reference values, typically direct observations.
A diagram is built by plotting one model against the reference,
then adding alternative model points. If \samp{normalize=TRUE}
when plotting the first model, remember to set it to \samp{TRUE}
when plotting additional models.
Two displays are available. One displays the entire range of correlations
from -1 to 1. Setting \samp{pos.cor} to \samp{FALSE} will produce this
display. The -1 to 1 display includes a radial grid for the correlation
values. When \samp{pos.cor} is set to \samp{TRUE}, only the
range from 0 to 1 will be displayed. The \samp{gamma} lines and the arc at
the reference standard deviation are optional in this display.
Both the standard deviation arcs and the gamma lines are optional in the
\samp{pos.cor=TRUE} version. Setting \samp{sd.arcs} or \samp{grad.corr.lines}
to zero or FALSE will cause them not to be displayed. If more than one value is
passed for \samp{sd.arcs}, the function will try to use the values passed,
otherwise it will call \samp{pretty} to calculate the values.
}
\value{
The values of \samp{par} that preceded the function. This allows the
user to add points to the diagram, then restore the original values. This
is only necessary when using the 0 to 1 correlation range.
}
\references{
Taylor, K.E. (2001) Summarizing multiple aspects of model performance in a
single diagram. Journal of Geophysical Research, 106: 7183-7192.
}
\author{Olivier Eterradossi with modifications by Jim Lemon}
\examples{
# fake some reference data
ref<-rnorm(30,sd=2)
# add a little noise
model1<-ref+rnorm(30)/2
# add more noise
model2<-ref+rnorm(30)
# display the diagram with the better model
oldpar<-taylor.diagram(ref,model1)
# now add the worse model
taylor.diagram(ref,model2,add=TRUE,col="blue")
# get approximate legend position
lpos<-1.5*sd(ref)
# add a legend
legend(lpos,lpos,legend=c("Better","Worse"),pch=19,col=c("red","blue"))
# now restore par values
par(oldpar)
# show the "all correlation" display
taylor.diagram(ref,model1,pos.cor=FALSE)
taylor.diagram(ref,model2,add=TRUE,col="blue")
}
\keyword{misc}
plotrix/man/binciWu.Rd 0000755 0001762 0000144 00000001440 14011145766 014424 0 ustar ligges users \name{binciWu}
\alias{binciWu}
\title{Upper binomial confidence limit}
\description{
Returns the upper binomial confidence limit using the Wilson approximation.
}
\usage{
binciWu(x,n,alpha=0.05,trueval=TRUE,na.rm=TRUE)
}
\arguments{
\item{x}{The number of successes or failures for which the CI is to be calculated.}
\item{n}{The number of trials as above.}
\item{alpha}{The desired coverage - 0.05 produces 95 percent coverage}
\item{trueval}{The value representing the outcome of interest for the CI.}
\item{na.rm}{Argument needed to make this work}
}
\details{
\samp{binciWu} now calls \samp{binciW} and returns the upper limit.
}
\value{The upper binomial confidence interval}
\author{Jim Lemon}
\seealso{\link{binciWl}}
\examples{
binciWl(c(rep(5,TRUE),rep(37,FALSE)))
}
\keyword{misc}
plotrix/man/axis.break.Rd 0000755 0001762 0000144 00000003376 14011145766 015065 0 ustar ligges users \name{axis.break}
\alias{axis.break}
\title{ Place a "break" mark on an axis }
\description{
Places a "break" mark on an axis on an existing plot.
}
\usage{
axis.break(axis=1,breakpos=NULL,pos=NULL,bgcol="white",breakcol="black",
style="slash",brw=0.02)
}
\arguments{
\item{axis}{which axis to break}
\item{breakpos}{where to place the break in user units}
\item{pos}{position of the axis (see \link{axis}).}
\item{bgcol}{the color of the plot background}
\item{breakcol}{the color of the "break" marker}
\item{style}{Either \samp{gap}, \samp{slash} or \samp{zigzag}}
\item{brw}{break width relative to plot width}
}
\value{nil}
\details{
The \samp{pos} argument is not needed unless the user has specified a
different position from the default for the axis to be broken.
}
\note{
There is some controversy about the propriety of using discontinuous
coordinates for plotting, and thus axis breaks. Discontinuous coordinates
allow widely separated groups of values or outliers to appear without
devoting too much of the plot to empty space. The major objection seems
to be that the reader will be misled by assuming continuous coordinates.
The \samp{gap} style that clearly separates the two sections of the plot
is probably best for avoiding this.
}
\author{Jim Lemon and Ben Bolker}
\seealso{\link{gap.plot}}
\examples{
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)
}
\keyword{misc}
plotrix/man/multivari.Rd 0000644 0001762 0000144 00000014665 14116106365 015050 0 ustar ligges users \name{multivari}
\alias{multivari}
\title{
Function to draw a multivari chart
}
\description{
A multivari chart of one quantitative response variable depending on two
to four categorical variables can be drawn.
}
\usage{
multivari(var, fac1, fac2, fac3 = NULL, fac4 = NULL, data, sort = FALSE,
fun = mean, pch = list(15, 16, 17), col = list("black", "blue", "red"),
col0 = "black", cex = 1, fac.cex = 2, xlab.depth = 3, legend = FALSE,
main = paste("multivari chart of", var), add = FALSE, ...)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
\item{var}{variable name (character string) or column index of response
variable, required
}
\item{fac1}{variable name (character string) or column index of first
level factor, required; precedes \code{fac2} and \code{fac3} (if present) in the hierarchy (see Details)
}
\item{fac2}{variable name (character string) or column index of second
level factor, required; follows \code{fac1} and precedes \code{fac3} (if present)
in the hierarchy (see Details)
}
\item{fac3}{variable name (character string) or column index of third
level factor, optional; if present, \code{fac3} is the last factor in the hierarchy (see Details)
}
\item{fac4}{
variable name (character string) or column index of fourth level factor,
optional; can only be specified if there is also a third level factor;
if present, this factor is the first in the hierarchy (see Details), and separate multivari charts for the first three factors are drawn for each level of this factor}
\item{data}{
a data frame, required
}
\item{sort}{
logical, specifying whether or not levels are sorted, when converting
character vectors to factors (a single choice for all factors is needed); default: \code{FALSE}
}
\item{fun}{
a function to be used in aggregation; default: \code{mean}
}
\item{pch}{
a list of length 2 or 3, depending on whether or not \code{fac3} is
specified; the ith list element can be an individual plotting symbol
(like the usual \code{pch} entry) or a vector of plot symbols for each
level of \code{fac_i}
}
\item{col}{
a list of length 2 or 3, depending on whether or not \code{fac3} is
specified; the ith list element can be an individual color or a vector
of colors for each level of \code{fac_i}; this color specification is
used for the plot symbols of \code{fac_i} levels and for the lines
connecting the symbols for the next level in the hierarchy
}
\item{col0}{
the color for the first line to be drawn
}
\item{cex}{
the size of axis annotation text
(annotation of the fourth level header is 1.5 times this size)
}
\item{fac.cex}{
a multiplier for \code{cex}; plot symbol sizes are \code{fac.cex*cex};
default: 2
}
\item{xlab.depth}{
labels for the horizontal axis are printed down to this level of the
hierarchy (default: 3); if the depth is reduced, different plot symbols
should be used, and a legend should be drawn
}
\item{legend}{
logical determining whether or not a legend should be drawn (default:
FALSE); the function determines wether top right or bottom right yields
a better position (it is not guaranteed that there is no overlab); if
this does not work well, one can manually draw a legend in the outer
margin
}
\item{main}{
title, as usual; a default is provided
}
\item{add}{
logical; add to an existing plot (which of course has to have suitable axis limits)?; default: FALSE;
note that horizontal axis labeling will always be printed by function multivari, while vertical axis labeling will be omitted for \code{add=TRUE}
}
\item{\dots}{
further arguments to functions \code{plot}, \code{lines}, \code{points},
\code{mtext}
}
}
\details{
The function is inspired by Minitabs behavior for multivari charts
(see also Bruno Scibilia's blog which is linked in the references). It
does not attempt to visualize individual observations.
A multivari chart mainly serves exploratory purposes.
It works particularly well with balanced data, but can also be used for messy data.
\code{multivari} can visualize the dependence of a single quantitative variable on up to four factors (i.e., interactions of order up to four can be visualized). The display is hierarchical: for factors later in the hierarchy, conditional means given level combinations of factors earlier in the hierarchy are displayed. Therefore, the order of the
factors can make a big difference in the display. If there is no natural
order, it may be worthwhile to inspect several orders.
For interactions with two factors only, it is often preferrable to use
function \code{\link{interaction.plot}} or \code{\link{raw.means.plot}}.
}
\value{
a list of (lists of) data frames with summary statistics to be plotted
}
\references{
Scibilia, Bruno (2013). Using Multi-Vari Charts to Analyze Families of Variations. \url{https://blog.minitab.com/en/using-variability-charts-to-analyze-call-center-wait-times}.
}
\author{
Ulrike Groemping
}
\seealso{
See also \code{\link{interaction.plot}}, \code{\link{raw.means.plot}}
}
\examples{
##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
\dontrun{
require(car)
multivari("cycles", "len", "load", "amp", data=Wool,
col=list("black","red",c("grey70","grey45","grey20")),
pch=list(15,17,8), legend=TRUE, xlab.depth = 2, lwd=2)
multivari("cycles", "load", "len", "amp", data=Wool,
col=list("black",c("red","blue","darkgreen"),
c("grey70","grey45","grey20")),
pch=list(15,17,8), legend=TRUE, xlab.depth = 2, lwd=2)
## create a fake fourth factor
fakedat <- rbind(cbind(newfac="blabla",Wool),cbind(newfac="albalb",Wool))
## make it character for demonstrating the effect of sort option
fakedat$newfac <- as.character(fakedat$newfac)
## default: sort order in the data is respected (order of unique is used)
multivari("cycles", "load", "len", "amp", "newfac", data=fakedat,
col=list("black",c("red","blue","darkgreen"),
c("grey70","grey45","grey20")),
pch=list(15,17,8), legend=TRUE, xlab.depth = 2, lwd=2, cex=0.8)
## sort=TRUE: levels are sorted (order of sort(unique))
multivari("cycles", "load", "len", "amp", "newfac", data=fakedat,
col=list("black",c("red","blue","darkgreen"),
c("grey70","grey45","grey20")),
pch=list(15,17,8), legend=TRUE, xlab.depth = 2, lwd=2, cex=0.8,
sort=TRUE)
}
}
\keyword{ hplot }
\keyword{ design }
plotrix/man/floating.pie.Rd 0000755 0001762 0000144 00000005642 14011145766 015413 0 ustar ligges users \name{floating.pie}
\alias{floating.pie}
\title{Display a floating pie chart}
\description{
Displays a pie chart at an arbitrary position on an existing plot
}
\usage{
floating.pie(xpos=0,ypos=0,x,edges=200,radius=1,col=NULL,startpos=0,
shadow=FALSE,shadow.col=c("#ffffff","#cccccc"),explode=0,...)
}
\arguments{
\item{xpos,ypos}{x and y position of the center of the pie chart}
\item{x}{a numeric vector for which each value will be a sector}
\item{edges}{the number of lines forming a circle}
\item{radius}{the radius of the pie in user units}
\item{col}{the colors of the sectors - defaults to \samp{rainbow}}
\item{startpos}{The starting position for drawing sectors in radians.}
\item{shadow}{Logical - whether to draw a shadow}
\item{shadow.col}{Colors to use for a shadow.}
\item{explode}{How much to "explode" one or more of the sectors.}
\item{...}{graphical parameters passed to \samp{polygon}}
}
\details{
\samp{floating.pie} displays a pie chart with an optional shadow on an
existing plot (see \samp{polygon.shadow}). \samp{floating.pie} now accepts
NAs or zeros in \samp{x}, but simply ignores them.
\samp{floating.pie} can be useful when multiple pie charts are placed on a
plot overlaying something else, like a map.
}
\value{
The bisecting angle of the sectors in radians. Useful for placing
text labels for each sector. If any values in \samp{x} were zero or NA,
no angle is returned for that value. This means that the user must adjust
the labels accordingly if \samp{pie.labels} is called.
If \samp{floating.pie} is called with no graphics device, it will try to
open one with the appropriate dimensions.
If \samp{pie.labels} is called, ensure that the center of the pie chart
and any \samp{explode} values are the same.
}
\note{
As with most pie charts, simplicity is essential. Trying to display a
complicated breakdown of data rarely succeeds.
}
\author{Jim Lemon}
\seealso{\link{pie.labels}, \link{boxed.labels}, \link{polygon.shadow}}
\examples{
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"))
plot(0,xlim=c(-1.5,1.5),ylim=c(-1.5,1.5),type="n",axes=FALSE,
main="Floating pie with minor explosions",xlab="",ylab="")
floating.pie(x=1:5,explode=c(0,0.1,0,0.2,0))
}
\keyword{misc}
plotrix/man/cylindrect.Rd 0000755 0001762 0000144 00000003270 14011145766 015167 0 ustar ligges users \name{cylindrect}
\alias{cylindrect}
\title{Display an apparent cylinder}
\description{Display rectangles shaded to appear like cylinders.}
\usage{
cylindrect(xleft,ybottom,xright,ytop,col,border=NA,gradient="x",nslices=50)
}
\arguments{
\item{xleft}{The position of the left side of the rectangle(s).}
\item{ybottom}{The position of the bottom of the rectangle(s).}
\item{xright}{The position of the right side of the rectangle(s).}
\item{ytop}{The position of the top side of the rectangle(s).}
\item{col}{The base color(s) of the rectangles.}
\item{border}{Whether to draw a border and what color.}
\item{gradient}{Whether to vary the shading horizontally ("x" - the default)
or vertically (anything but "x").}
\item{nslices}{The number of "slices" of color for shading.}
}
\value{The base color(s) of the rectangle(s).}
\details{
\samp{cylindrect} displays a rectangle filled with "slices" of color that
simulate the appearance of a cylinder. The slices are calculated so that the
base color appears at the right or bottom edge of the rectangle, becomes
progressively lighter to a "highlight" at two thirds of the width or height
and then darkens toward the base color again.
The appearance is of a cylinder lit from above and to the left of the viewer.
The position of the apparent light source is hard coded into the function.
}
\author{Jim Lemon}
\seealso{\link{gradient.rect}}
\examples{
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")
}
\keyword{misc}
plotrix/man/radial.plot.Rd 0000755 0001762 0000144 00000024036 14114542502 015234 0 ustar ligges users \name{radial.plot}
\alias{radial.plot}
\title{
Plot values on a circular grid of 0 to 2*pi radians
}
\description{
Plot numeric values as distances from the center of a circular field in the
directions defined by angles in radians.
}
\usage{
radial.plot(lengths,radial.pos=NULL,labels=NA,label.pos=NULL,radlab=FALSE,
start=0,clockwise=FALSE,rp.type="r",label.prop=1.1,main="",xlab="",ylab="",
line.col=par("fg"),lty=par("lty"),lwd=par("lwd"),mar=c(2,2,3,2),
show.grid=TRUE,show.grid.labels=4,show.radial.grid=TRUE,rad.col="gray",
grid.col="gray",grid.bg="transparent",grid.left=FALSE,grid.unit=NULL,
point.symbols=1,point.col=par("fg"),show.centroid=FALSE,radial.lim=NULL,
radial.labels=NULL,boxed.radial=TRUE,poly.col=NA,add=FALSE,
loglen=FALSE,explab=FALSE,...)
}
\arguments{
\item{lengths}{A numeric data vector or matrix. If \samp{lengths}
is a matrix, the rows will be considered separate data vectors.}
\item{radial.pos}{A numeric vector or matrix of positions in radians.
These are interpreted as beginning at the right (0 radians) and moving
counterclockwise. If \samp{radial.pos} is a matrix, the rows must
correspond to rows of \samp{lengths}.}
\item{labels}{Character strings to be placed at the outer ends of
the lines. If set to NULL, will suppress printing of labels,
but if missing, the radial positions will be used.}
\item{label.pos}{The positions of the labels around the plot in radians.}
\item{radlab}{Whether to rotate the outer labels to a radial orientation.}
\item{start}{Where to place the starting (zero) point. Defaults to the
3 o'clock position.}
\item{clockwise}{Whether to interpret positive positions as clockwise from
the starting point. The default is counterclockwise.}
\item{rp.type}{Whether to draw (r)adial lines, a (p)olygon, (s)ymbols, (t)ext,
or some combination of these. If \samp{lengths} is a matrix and rp.type is
a vector, each row of \samp{lengths} can be displayed differently.}
\item{label.prop}{The label position radius as a proportion of the
maximum line length.}
\item{main}{The title for the plot.}
\item{xlab,ylab}{Normally x and y axis labels are suppressed.}
\item{line.col}{The color of the radial lines or polygons drawn.}
\item{lty}{The line type(s) to be used for polygons or radial lines.}
\item{lwd}{The line width(s) to be used for polygons or radial lines.}
\item{mar}{Margins for the plot. Allows the user to leave space for
legends, long labels, etc.}
\item{show.grid}{Logical - whether to draw a circular grid.}
\item{show.grid.labels}{Whether and where to display labels for the grid
- see Details.}
\item{show.radial.grid}{Whether to draw radial lines to the plot labels.}
\item{rad.col}{Color of the radial lines on the grid.}
\item{grid.col}{Color of the circumferential lines on the grid.}
\item{grid.bg}{Fill color of above.}
\item{grid.left}{Whether to place the radial grid labels on the left side.}
\item{grid.unit}{Optional unit description for the grid.}
\item{point.symbols}{The symbols for plotting (as in pch) or if
\samp{rp.type} is "t", the text that will be displayed.}
\item{point.col}{Colors for the symbols.}
\item{show.centroid}{Whether to display a centroid.}
\item{radial.lim}{The range of the grid circle. Defaults to
\samp{pretty(range(lengths))}, but if more than two values are passed, the
exact values will be displayed.}
\item{radial.labels}{Optional labels for the radial grid. The default is
the values of radial.lim, or if loglen is TRUE, the corresponding log
values.}
\item{boxed.radial}{Whether to use boxed.labels or text for radial labels.}
\item{poly.col}{Fill color if polygons are drawn. Use NA for no fill.}
\item{add}{Whether to add one or more series to an existing plot.}
\item{loglen}{Whether to log transform the \samp{length} values. Only base
10 logs are available. Keep in mind that the values actually plotted will be
the logarithms, although the exponentiated logs are displayed.}
\item{explab}{Whether to use the default fixed (FALSE) or exponential (TRUE)
notation for the radial labels.}
\item{...}{Additional arguments are passed to \samp{plot}.}
}
\value{
The \samp{par} values that are changed in the function
as they were at the time \samp{radial.plot} was called.
}
\details{
\samp{radial.plot} displays a plot of radial lines, polygon(s),
symbols, text or a combination of these centered at the midpoint of
the plot frame, the lengths, vertices or positions corresponding
to the numeric magnitudes of the data values. Note that if log transformation is requested with \samp{loglen}, the values plotted will be the logs, not the values displayed on the plot.
If \samp{show.centroid}
is TRUE, an enlarged point at the centroid of values is displayed. The
centroid is calculated as the average of x and y values unless
\samp{rp.type="p"}. In this case, the barycenter of the polygon is
calculated. Make sure that these suit your purpose, otherwise calculate
the centroid that you really want and add it with the \samp{points} function.
Note that if the observations are not taken at equal intervals around the
circle, the centroid may not mean much.
The \samp{text} option for \samp{rp.type} allows the user to place text at
each point. It is useful for adding labels at arbitrary points on an existing
plot or perhaps labelling points with letters or digits rather than different symbols. See the last example.
If the user wants to plot several sets of lines, points or symbols by
passing matrices or data frames of \samp{lengths} and \samp{radial.pos},
remember that these will be grouped by row, so transpose if the data are
grouped by columns.
If more series are added to an existing plot,
\samp{radial.plot} will try to maintain the current plot parameters.
Resetting the parameters after doing the initial plot will almost certainly
mess up any series that are added. Series that are added will be plotted
"on top" of the existing plot, possibly overplotting other things. If the
added series have a larger range than the initial series, set \samp{radial.lim}
to account for this in the initial plot, and if \samp{radial.lim} is specified
in the initial plot, remember to repeat it for added series as in the example.
The size of the labels on the outside of the plot can be adjusted by
setting \samp{par(cex.axis=)} and that of the labels inside by setting
\samp{par(cex.lab=)}. If \samp{radlab} is TRUE, the labels will be rotated
to a radial alignment. This may help when there are many values and labels.
If some labels are still crowded, try running \samp{label.pos} through the
\samp{spreadout} function. If the \samp{show.grid.labels} argument is a number
from 1 to 4, the labels will be placed along a horizontal or vertical radius.
The numbers represent the same positions as in \samp{axis}, with the default
(4) on the right.
The radial.plot family of plots is useful for illustrating
cyclic data such as wind direction or speed (but see \samp{oz.windrose}
for both), activity at different times of the day, and so on. While
\samp{radial.plot} actually does the plotting, another function is usually
called for specific types of cyclic data.
}
\author{Jim Lemon}
\note{Thanks to
Jeremy Claisse and Antonio Hernandez Matias for the
\samp{lty} and \samp{rp.type} suggestions respectively
Patrick Baker for the request that led to \samp{radlab}
Thomas Steiner for the request for the \samp{radial.lim} and \samp{radial.labels} modifications
Evan Daugharty for requesting the \samp{add} argument
James MacCarthy for requesting better radial labels
Steve Ellison for noticing that the return values of the functions had changed
Don Dennerline for requesting the rank clock
Mehdi Nellen for the different colors for the radial and circumferential lines for the grid
Mayeul Kauffmann for noticing the radial label bug when a separate radial.grid was included
Ogbos Okike for requesting a text option for rp.type
Keziah Conroy for requesting the log option
}
\seealso{\link{polar.plot},\link{clock24.plot}}
\examples{
testlen<-runif(10,0,10)
testpos<-seq(0,18*pi/10,length=10)
testlab<-letters[1:10]
oldpar<-radial.plot(testlen,testpos,main="Test Radial Lines",line.col="red",
lwd=3,rad.col="lightblue")
testlen<-c(sin(seq(0,1.98*pi,length=100))+2+rnorm(100)/10)
testpos<-seq(0,1.98*pi,length=100)
radial.plot(testlen,testpos,rp.type="p",main="Test Polygon",line.col="blue",
labels=LETTERS[1:8],label.pos=seq(0,14*pi/8,length.out=8))
# now do a 12 o'clock start with clockwise positive
radial.plot(testlen,testpos,start=pi/2,clockwise=TRUE,show.grid.labels=2,
rp.type="s",main="Test Symbols (clockwise)",radial.lim=c(0,3.5),
point.symbols=16,point.col="green",show.centroid=TRUE,
labels=LETTERS[1:6],label.pos=seq(0,10*pi/6,length.out=6))
# one without the circular grid and multiple polygons
# see the "diamondplot" function for variation on this
posmat<-matrix(sample(2:9,30,TRUE),nrow=3)
radial.plot(posmat,labels=paste("X",1:10,sep=""),rp.type="p",
main="Spiderweb plot",line.col=2:4,show.grid=FALSE,lwd=1:3,
radial.lim=c(0,10))
# dissolved ions in water
ions<-c(3.2,5,1,3.1,2.1,4.5)
ion.names<-c("Na","Ca","Mg","Cl","HCO3","SO4")
radial.plot(ions,labels=ion.names,rp.type="p",main="Dissolved ions in water",
grid.unit="meq/l",radial.lim=c(0,5),poly.col="yellow",show.grid.labels=3)
# add the names of the ions to the plot
radial.plot(ions,rp.type="t",point.symbols=ion.names,radial.lim=c(0,5),
add=TRUE)
# add points inside the polygon - radial.lim is supplied by plotrix_env
radial.plot(ions-0.4,rp.type="s",point.symbols=4,point.col="red",add=TRUE)
radmat<-matrix(c(sample(1:4,4),sample(1:4,4),sample(1:4,4),sample(1:4,4),
sample(1:4,4),sample(1:4,4),sample(1:4,4),sample(1:4,4),
sample(1:4,4),sample(1:4,4)),nrow=4)
# finally a rank clock
radial.plot(radmat,rp.type="l",radial.pos=seq(0,20*pi/11.1,length.out=10),
label.pos=seq(0,20*pi/11.1,length.out=10),start=pi/2,clockwise=TRUE,
labels=2001:2010,radial.lim=c(0.2,4),main="Rank clock")
legend(-1.7,4,c("Black","Red","Green","Blue"),col=1:4,lty=1)
par(xpd=oldpar$xpd,mar=oldpar$mar,pty=oldpar$pty)
# reset the margins
par(mar=c(5,4,4,2))
}
\keyword{misc}
plotrix/man/pie.labels.Rd 0000755 0001762 0000144 00000003504 14011145766 015045 0 ustar ligges users \name{pie.labels}
\alias{pie.labels}
\title{ Place labels on a pie chart }
\description{
Places labels on a pie chart
}
\usage{
pie.labels(x=0,y=0,angles,labels,radius=1.05,bg="white",border=TRUE,
minangle=NA,boxed=FALSE,explode=0,...)
}
\arguments{
\item{x,y}{x and y position of the center of the pie chart}
\item{angles}{A numeric vector representing angles in radians. This is
the return value of \samp{floating.pie}.}
\item{labels}{Text strings to label each sector.}
\item{radius}{The radius at which to place the labels in user units. The
default is 1.05.}
\item{bg}{The color of the rectangles on which the labels are displayed.}
\item{border}{Whether to draw borders around the rectangles.}
\item{minangle}{Minimum angle between labels.}
\item{boxed}{Whether to use \samp{text} or \samp{boxed.labels} to display
the labels.}
\item{explode}{How much the pie chart has been "exploded".}
\item{...}{Arguments passed to \samp{text} or \samp{boxed.labels}.}
}
\value{nil}
\details{
Labels may be placed within the pie (radius less than the pie radius),
on the edge or outside as in the examples below. If within the pie, it
is probably best to use \samp{boxed=TRUE}.
If some labels overlap, passing a value in radians for \samp{minangle}
may be used to spread them out.
}
\note{
Remember that \samp{x} and \samp{y} specify the center of the pie chart and
that the label positions are specified by angles and radii from that
center.
}
\author{Jim Lemon}
\seealso{\link{floating.pie}, \link{boxed.labels}, \link{spreadout}}
\examples{
pieval<-c(2,1,3,94)
plot(0,xlim=c(1.5,5),ylim=c(1,5),type="n",axes=FALSE,xlab="",ylab="")
box()
bisect.angles<-floating.pie(3,3,pieval,explode=c(0.1,0.2,0.3,0))
pie.labels(3,3,bisect.angles,c("two","one","three","ninety\nfour"),
minangle=0.2,,explode=c(0.1,0.2,0.3,0))
}
\keyword{misc}
plotrix/man/spread.labels.Rd 0000755 0001762 0000144 00000005400 14011145766 015543 0 ustar ligges users \name{spread.labels}
\alias{spread.labels}
\title{ Spread labels for irregularly spaced values }
\description{
Places labels for irregularly spaced values in a regular staggered order
}
\usage{
spread.labels(x,y,labels=NULL,ony=NA,offsets=NA,between=FALSE,
linecol=par("fg"),srt=0,...)
}
\arguments{
\item{x,y}{x and y data values}
\item{labels}{text strings}
\item{ony}{Whether to force the labels to be spread horizontally
(FALSE) or vertically (TRUE). Defaults to whichever way the points are
most spread out.}
\item{offsets}{How far away from the data points to place the labels.
Defaults to one quarter of the plot span for all, staggered on each side.}
\item{between}{Whether to place the labels between two sets of points.}
\item{linecol}{Optional colors for the lines drawn to the points.}
\item{srt}{Rotation of the labels in degrees.}
\item{...}{additional arguments passed to \samp{text}.}
}
\details{
This function is mainly useful when labeling irregularly spaced data points
that are "spread out" along one dimension. It places the labels regularly
spaced and staggered on the long dimension of the data, drawing lines from
each label to the point it describes.
If \samp{between} is TRUE, the function expects two points for each label
and will attempt to place the labels between two vertical lines of points.
Lines will be drawn from the ends of each label to the two corresponding
points.
If spreading labels horizontally, the user may wish to rotate the labels by
90 degrees (\samp{srt=90}). If long labels run off the edge of the plot,
increase the \samp{xlim} for extra room.
}
\value{nil}
\author{Jim Lemon}
\references{
Cooke, L.J. & Wardle, J. (2005) Age and gender differences in
children's food preferences. British Journal of Nutrition, 93: 741-746.
}
\seealso{\samp{text}, \samp{spread.lab (TeachingDemos)}}
\examples{
# spread labels out in the x dimension using defaults
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)
# food preferences of children by sex (Cooke & Wardle, 2005)
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="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"))
}
\keyword{misc}
plotrix/man/symbolbarplot.Rd 0000755 0001762 0000144 00000003130 14011145766 015713 0 ustar ligges users \name{symbolbarplot}
\alias{symbolbarplot}
\title{barplot filled with symbols}
\description{
Produces a barplot where each piece of the barplot is filled with the
number of symbols equal to the size of the bar
}
\usage{
symbolbarplot(height,width=1,space=NULL,names.arg=NULL,
legend.text=NULL,beside=FALSE,horiz=FALSE,col=heat.colors(NR),
border=par("fg"),main=NULL,sub=NULL,xlab=NULL,ylab=NULL,xlim=NULL,
ylim=NULL,axes=TRUE,axisnames=TRUE,inside=TRUE,plot=TRUE,rel.width=0.8,
symbol="circles",symbbox=TRUE,debug=FALSE,...)
}
\arguments{
\item{height}{numeric vector or matrix of barplot heights}
\item{width}{width of bars}
\item{space}{space between bars}
\item{names.arg}{vector of names}
\item{legend.text}{vector of legend text}
\item{beside}{(logical) plot bars beside each other?}
\item{horiz}{(logical) horizontal barplot?}
\item{col}{vector of colors}
\item{border}{plot border?}
\item{main}{main title}
\item{sub}{subtitle}
\item{xlab}{x axis label}
\item{ylab}{y axis label}
\item{xlim}{x limits}
\item{ylim}{y limits}
\item{axes}{draw axes?}
\item{axisnames}{label horizontal axis?}
\item{inside}{draw lines dividing adjacent bars?}
\item{plot}{produce plot?}
\item{rel.width}{relative width of symbols}
\item{symbol}{which symbol to use}
\item{symbbox}{draw boxes for symbol boxes?}
\item{debug}{debug output?}
\item{\dots}{further arguments to multsymbolbox}
}
\value{
Nil
}
\note{This is a mostly a hack of barplot()}
\author{Ben Bolker}
\examples{
set.seed(1001)
bvals <- matrix(rpois(12,20),nrow=3)
b <- symbolbarplot(bvals)
}
\keyword{hplot}
plotrix/man/lengthKey.Rd 0000755 0001762 0000144 00000002235 14011145766 014761 0 ustar ligges users \name{lengthKey}
\alias{lengthKey}
\title{Key for interpreting lengths in a plot}
\description{Key for interpreting lengths in a plot}
\usage{
lengthKey(x,y,tickpos,scale)
}
\arguments{
\item{x,y}{The position of the left end of the key in user units.}
\item{tickpos}{The labels that will appear above the key.}
\item{scale}{A value that will scale the length of the key.}
}
\value{nil}
\details{
\samp{lengthKey} displays a line with tick marks and the values in
\samp{tickpos} above those tickmarks. It is useful when line segments
on a plot represent numeric values. Note that if the plot does not have
a 1:1 aspect ratio, a length key is usually misleading.
}
\author{Jim Lemon}
\seealso{\link{segments}, \link{arrows}}
\examples{
# manufacture a matrix of orientations in radians
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)
# get an empty plot of approximately 1:1 aspect ratio
plot(0,xlim=c(0.7,8.3),ylim=c(0.7,7.3),type="n")
vectorField(o,m,vecspec="rad")
# the scaling usually has to be worked out by trial and error
lengthKey(0.3,-0.5,c(0,5,10),0.24)
}
\keyword{misc}
plotrix/man/gap.plot.Rd 0000755 0001762 0000144 00000007754 14011145766 014566 0 ustar ligges users \name{gap.plot}
\alias{gap.plot}
\title{Display a plot with one or two gaps (missing ranges) on one axis}
\description{
Displays a plot with one or two missing ranges on one of the axes.
}
\usage{
gap.plot(x,y,gap,gap.axis="y",bgcol="white",breakcol="black",brw=0.02,
xlim=range(x),ylim=range(y),xticlab,xtics=NA,yticlab,ytics=NA,
lty=rep(1,length(x)),col=rep(par("col"),length(x)),pch=rep(1,length(x)),
add=FALSE,stax=FALSE,...)
}
\arguments{
\item{x,y}{data values}
\item{gap}{the range(s) of values to be left out}
\item{gap.axis}{whether the gaps are to be on the x or y axis}
\item{bgcol}{the color of the plot background}
\item{breakcol}{the color of the "break" marker}
\item{brw}{break width relative to plot width}
\item{xlim,ylim}{the plot limits.}
\item{xticlab}{labels for the x axis ticks}
\item{xtics}{position of the x axis ticks}
\item{yticlab}{labels for the y axis ticks}
\item{ytics}{position of the y axis ticks}
\item{lty}{line type(s) to use if there are lines}
\item{col}{color(s) in which to plot the values}
\item{pch}{symbols to use in plotting.}
\item{add}{whether to add values to an existing plot.}
\item{stax}{whether to call staxlab for staggered axis labels.}
\item{...}{arguments passed to \samp{plot} and \samp{points}.}
}
\value{nil}
\details{
Displays a plot omitting one or two ranges of values on one axis.
Typically used when there is a relatively large gap or two in the overall
range of one set of values, often because of outliers. The function warns
the user if any values may have been omitted by being in the "gap". See
\link{axis.break} for a brief discussion of plotting on
discontinuous coordinates.
To add more data series to a gap plot, call \samp{gap.plot} with
\samp{add = TRUE}. The same \samp{gap} and \samp{gap.axis} arguments as
in the initial call must be passed or the data will not be displayed
correctly. Remember to pass an explicit \samp{xlim} or \samp{ylim} to
the initial call if the added data exceed the range of the data
initially displayed. Also remember to subtract the width(s) of the gap(s)
if you are passing an explicit \samp{xlim} or \samp{ylim}.
Because the gaps take up some space, it is possible to have a data value
that is just below a gap plotted in the gap. The answer is to make the lower
gap limit a little higher if this is a problem.
If at least four values are passed in \samp{gap}, the first four will be
used to calculate two "gaps" in the plot instead of one. The function does
not check whether these values are sensible, so it is quite easy to
ask for a very silly plot.
The default ticks are usually not ideal, and most users will want to pass
their own tick positions and perhaps labels. Note that \samp{lines} appears
to use only the first \samp{col} and \samp{lty} argument value, so if you
must have lines with different colors and types, use \samp{add=TRUE} and add
them separately (see the third example for the problem and the solution).
}
\author{Jim Lemon and Ben Bolker (thanks to Zheng Lu for the "add" idea,
and Art Roberts for helping to get the gaps right.)}
\seealso{\link{gap.barplot}, \link{axis.break}, \link{do.first}}
\examples{
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="Gap on Y axis",col=gpcol)
gap.plot(twogrp,rnorm(20),gap=c(8,16),gap.axis="x",xlab="X values",
xtics=c(4,7,17,20),ylab="Y values",main="Gap on X axis with added lines")
gap.plot(c(seq(3.5,7.5,by=0.5),seq(16.5,22.5,by=0.5)),
rnorm(22),gap=c(8,16),gap.axis="x",type="l",add=TRUE,col=2,)
gap.plot(twogrp,gap=c(8,16,25,35),
xlab="X values",ylab="Y values",xlim=c(1,30),ylim=c(0,42),
main="Test two gap plot with the lot",xtics=seq(0,30,by=5),
ytics=c(4,6,18,20,22,38,40,42),
lty=c(rep(1,10),rep(2,10)),
pch=c(rep(2,10),rep(3,10)),
col=c(rep(2,10),rep(3,10)),
type="b")
gap.plot(21:30,rnorm(10)+40,gap=c(8,16,25,35),add=TRUE,
lty=rep(3,10),col=rep(4,10),type="l")
}
\keyword{misc}
plotrix/man/soils.Rd 0000755 0001762 0000144 00000000626 14011145766 014162 0 ustar ligges users \name{soils}
\alias{soils}
\title{Soil texture data from 125 soils}
\description{
A set of 125 soil texture measurements from soils from various parts of the
world.
}
\usage{
data(soils)
}
\source{
T.H. Skaggs, L.M. Arya, P.J. Shouse and B.P. Mohanty (2001)
Estimating Particle-Size Distribution from Limited Soil Texture Data.
Soil Science Society of America Journal 65:1038-1044.
}
\keyword{misc}
plotrix/man/sumbrk.Rd 0000644 0001762 0000144 00000001247 14011145766 014331 0 ustar ligges users \name{sumbrk}
\alias{sumbrk}
\title{Count specified values in a vector}
\description{
Counts the number of values in a vector that are equal to a specified value.
}
\usage{
sumbrk(x,trueval=TRUE,na.rm=TRUE)
}
\arguments{
\item{x}{a character, factor or numeric vector.}
\item{trueval}{the value to be matched in \samp{x}.}
\item{na.rm}{whether to remove NA values.}
}
\details{
\samp{sumbrk} counts the values in \samp{x} matching a specified value.
It is mainly to allow these sums to be calculated in the \samp{brkdnNest}
function.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{brkdnNest}}
\examples{
sumbrk(sample(LETTERS,100,TRUE),trueval="M")
}
\keyword{misc}
plotrix/man/find_max_cell.Rd 0000644 0001762 0000144 00000001150 14011145766 015603 0 ustar ligges users \name{find_max_cell}
\alias{find_max_cell}
\title{Maximum (or minimum) value cell in a matrix.}
\description{
Find the indices of the maximum value in a matrix.
}
\usage{ find_max_cell(x,max=TRUE) }
\arguments{
\item{x}{a numeric matrix}
\item{max}{The default is to return the indices of the maximum value(s).
\samp{max=FALSE} returns those of the minimum.}
}
\value{
A list containing the column (x) and row (y) indices.
}
\note{
Intended to enable the user to mark cells in samp{color2D.matplot}.
Remember to subtract 0.5 from both values to center the mark in the cell.
}
\author{Jim Lemon}
\keyword{misc}
plotrix/man/color2D.matplot.Rd 0000755 0001762 0000144 00000017716 14011145766 016024 0 ustar ligges users \name{color2D.matplot}
\alias{color2D.matplot}
\title{Display a numeric matrix as color matrix}
\description{
Display the values of a numeric 2D matrix or data frame as colored
rectangles or hexagons.
}
\usage{
color2D.matplot(x,cs1=c(0,1),cs2=c(0,1),cs3=c(0,1),
extremes=NA,cellcolors=NA,show.legend=FALSE,nslices=10,xlab="Column",
ylab="Row",do.hex=FALSE,axes=TRUE,show.values=FALSE,vcol=NA,vcex=1,
border="black",na.color=NA,xrange=NULL,color.spec="rgb",yrev=TRUE,
xat=NULL,yat=NULL,Hinton=FALSE,add=FALSE,...)
}
\arguments{
\item{x}{data values}
\item{cs1,cs2,cs3}{the color parameters that will be scaled to represent
the range of numeric values. (see \samp{color.scale})}
\item{extremes}{The colors for the extreme values of \samp{x}. Takes
precedence over the color ranges.}
\item{cellcolors}{A precalculated matrix of cell colors. This must have
the same number of rows and columns as the matrix or it will be
uninformative. It can be a vector, but be careTakes precedence over both \samp{extremes}
and color ranges.}
\item{show.legend}{whether to display a color legend with the
extreme numeric values in the lower left corner of the plot. This will
force the color specification to "rgb", so if this is different from
the color specification requested, call \samp{color.legend} separately.}
\item{nslices}{The number of color "slices" in the legend.}
\item{xlab,ylab}{axis labels for the plot.}
\item{do.hex}{plot packed hexagons instead of rectangles.}
\item{axes}{Whether to suppress the default axis labelling.}
\item{show.values}{Whether to display the numeric values of \samp{x}.
This also controls the number of decimal places displayed.}
\item{vcol}{The color for the value display. If NA, the values are displayed
in black or white depending upon the darkness of the cell color.}
\item{vcex}{The character expansion for the value display.}
\item{border}{The color(s) for the borders of the cells. Pass NA
if no border is wanted.}
\item{na.color}{The color to use for NA values of \samp{x}.}
\item{xrange}{An explicit range for the transformation of colors.
see \samp{color.scale}}
\item{color.spec}{The color specification system to use.}
\item{yrev}{Whether to reverse the order of the y-axis to display the
cells in "reading" order (left to right and top to bottom) if TRUE,
or in the order of a typical plot (left to right and bottom to top) if
FALSE.}
\item{xat,yat}{Values at which to place tick marks to override \samp{pretty}.}
\item{Hinton}{Whether to display a Hinton diagram in which the magnitude of
cell values is proportional to the size of the squares and the sign is
indicated by the color of the squares.}
\item{add}{If TRUE, no plot is created and the rectangles are displayed over
whatever is on the current device (see the "iris" example).}
\item{...}{arguments passed to \samp{plot}.}
}
\value{nil}
\details{
Displays a plot with the same number of rectangular or hexagonal cells as
there are numeric values in the matrix or data frame. Each rectangle is
colored to represent its corresponding value. The rectangles are arranged
in the conventional display of a 2D matrix with rows beginning at the top
and columns at the left. To get the rows beginning at the bottom, use
\samp{yrev=FALSE}. The color scale defaults to black for the minimum
value and white for the maximum.
The user will have to adjust the plot device dimensions to get regular
squares or hexagons, especially when the matrix is not square. As the
margins are not equivalent for all display devices, this is currently
a matter of trial and error. Drawing hexagons is quite slow.
\samp{show.values} and \samp{show.legend} are also used to control the
number of decimal places displayed if the values or legend are shown.
\samp{TRUE} will give one decimal place, \samp{2} two, and so on.
if \samp{Hinton} is TRUE, a Hinton diagram in which the sizes of the
squares are proportional to the absolute value of \samp{x} and the colors
of the squares indicate the sign of the \samp{x} values will be displayed.
This only works with squares.
If \samp{add} is true, the color matrix is added to the current plot. This
is probably only useful when displaying plots that are mostly transparent.
}
\note{
The function \link{image} performs almost the same when passed a
matrix of values without grid positions, except that it assigns values to
a specified list of colors rather than calculating a color for each distinct
value.
}
\author{Jim Lemon (thanks to Ashoka Polpitiya for \samp{axes})}
\seealso{\link{color.scale}, \link{fill.corner}, \link{image}}
\examples{
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")
x<-matrix(rnorm(100),nrow=10)
# generate colors that show negative values in red to brown
# and positive in blue-green to green
cellcol<-matrix(rep("#000000",100),nrow=10)
cellcol[x<0]<-color.scale(x[x<0],c(1,0.8),c(0,0.8),0)
cellcol[x>0]<-color.scale(x[x>0],0,c(0.8,1),c(0.8,0))
# now do hexagons without borders
color2D.matplot(x,cellcolors=cellcol,xlab="Columns",ylab="Rows",
do.hex=TRUE,main="2D matrix plot (hexagons)",border=NA)
# for this one, we have to do the color legend separately
# because of the two part color scaling
legval<-seq(min(x),max(x),length.out=6)
legcol<-rep("#000000",6)
legcol[legval<0]<-color.scale(legval[legval<0],c(1,0.8),c(0,0.8),0)
legcol[legval>0]<-color.scale(legval[legval>0],0,c(0.8,1),c(0.8,0))
color.legend(0,-1.8,3,-1.4,round(c(min(x),0,max(x)),1),rect.col=legcol)
# do a color only association plot
xt<-table(sample(1:10,100,TRUE),sample(1:10,100,TRUE))
observed<-xt[,rev(1:dim(xt)[2])]
expected<-outer(rowSums(observed),colSums(observed),"*")/sum(xt)
deviates<-(observed-expected)/sqrt(expected)
cellcol<-matrix(rep("#000000",100),nrow=10)
cellcol[deviates<0]<-
color.scale(deviates[deviates<0],c(1,0.8),c(0,0.5),0)
cellcol[deviates>0]<-
color.scale(deviates[deviates>0],0,c(0.7,0.8),c(0.5,0))
color2D.matplot(x=round(deviates,2),cellcolors=cellcol,
show.values=TRUE,main="Association plot")
# Hinton diagram
border.col<-color.scale(x,extremes=2:3)
color2D.matplot(x,extremes=c(2,3),main="Hinton diagram (green +, red -)",
Hinton=TRUE,border=border.col)
# waffle plot of percentages with two contributing elements
waffle.col<-fill.corner(c(rep("red",18),rep("blue",45)),10,10)
color2D.matplot(matrix(1:100,nrow=10),cellcolors=waffle.col,yrev=FALSE,
border="lightgray",xlab="",ylab="",main="Waffle plot",axes=FALSE)
# coarse density plot of the iris petal data
spnames<-unique(iris$Species)
spcols<-c("red","green","blue")
matmax<-list()
cindx<-1
for(isp in spnames) {
petal_mat<-makeDensityMatrix(iris[iris$Species == isp,"Petal.Length"],
iris[iris$Species == isp,"Petal.Width"],
nx=20,ny=20,xlim=c(1,7),ylim=c(0,2.5),geocoord=FALSE)
# center the maximum markers in the cells
matmax[[cindx]]<-lapply(find_max_cell(petal_mat),"-",0.5)
if(isp == "setosa")
color2D.matplot(petal_mat,main="Iris petal length by petal width",
xlab="Petal length (cm)",ylab="Petal width (cm)",axes=FALSE,
cellcolors=color.scale(petal_mat,extremes=spcols[cindx],alpha=c(0,1)),
border=NA,yrev=FALSE)
else
color2D.matplot(petal_mat,border=NA,yrev=FALSE,add=TRUE,
cellcolors=color.scale(petal_mat,extremes=spcols[cindx],alpha=c(0,1)))
cindx<-cindx+1
}
axis(1,at=seq(0,20,by=3.33),labels=1:7)
axis(2,at=seq(0,20,length.out=4),labels=seq(1,2.5,by=0.5))
legend(1,6,paste0(spnames,"(",1:3,")"),fill=c("red","green","blue"))
for(cindx in 1:3)
text(matmax[[cindx]],as.character(cindx),col="white",cex=1.5)
}
\keyword{misc}
plotrix/man/addtable2plot.Rd 0000755 0001762 0000144 00000005750 14011145766 015555 0 ustar ligges users \name{addtable2plot}
\alias{addtable2plot}
\title{Add a table of values to a plot}
\description{
Displays a table of values at a user-specified position on an existing plot}
\usage{
addtable2plot(x,y=NULL,table,lwd=par("lwd"),bty="n",bg=par("bg"),
cex=1,xjust=0,yjust=1,xpad=0.1,ypad=0.5,box.col=par("fg"),text.col=par("fg"),
display.colnames=TRUE,display.rownames=FALSE,hlines=FALSE,vlines=FALSE,
title=NULL)
}
\arguments{
\item{x,y}{Either x and y coordinates to locate the table or an
\samp{xy.coords} object.}
\item{table}{A data frame, matrix or similar object that will be displayed.}
\item{lwd}{The line width for the box and horizontal dividers.}
\item{bty}{Whether to draw a box around the table ("o") or not ("n").}
\item{bg}{The background color for the table.}
\item{cex}{Character expansion for the table.}
\item{xjust,yjust}{Positioning for the table relative to \samp{x,y}.}
\item{xpad,ypad}{The amount of padding around text in the cells as a
proportion of the maximum width and height of the strings in each column.}
\item{box.col}{The color for the box and lines.}
\item{text.col}{The color for the text.}
\item{display.colnames}{Whether to display the column names in the table.}
\item{display.rownames}{Whether to display the row names in the table.}
\item{hlines}{Whether to draw horizontal lines between each row of the table.}
\item{vlines}{Whether to draw vertical lines between each column of the table.}
\item{title}{Optional title placed over the table.}
}
\value{nil}
\details{
\samp{addtable2plot} displays the values in \samp{table} at a position in user
coordinates specified by \samp{x,y}. The two justification arguments,
\samp{xjust} and \samp{yjust} are the same as in the \samp{legend} function,
and \samp{addtable2plot} has been programmed to be as similar to \samp{legend}
as possible. The function now accepts the positional arguments such as
"topright" if passed as \samp{x}. The defaults are those that were most
popular in scientific journals at the time of programming.
If \samp{bg} is a matrix of colors of the same dimensions as \samp{x}, those
colors will be the backgrounds of the cells. The default is no background color.
}
\author{Original by John Kane, mods by Jim Lemon and Brian Diggs. Thanks to
Andrija Djurovic for asking for the individual cell colors and Gabor Grothendieck
for alerting me to the problem of widely varying column widths.}
\seealso{\link{legend}}
\examples{
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)
# show most of the options including the christmas tree colors
abg <- matrix(c(2, 3, 5, 6, 7, 8), nrow=4, ncol=3)
addtable2plot(2, 8, testdf, bty = "o", display.rownames = TRUE, hlines = TRUE,
vlines = TRUE, title = "The table", bg = abg)
}
\keyword{misc}
plotrix/man/fan.plot.Rd 0000755 0001762 0000144 00000004766 14011145766 014563 0 ustar ligges users \name{fan.plot}
\alias{fan.plot}
\title{ Display a fan plot }
\description{
Displays numerical values as the arcs of overlapping sectors.
}
\usage{
fan.plot(x,edges=200,radius=1,col=NULL,align.at=NULL,max.span=NULL,
labels=NULL,labelpos=NULL,label.radius=1.2,align="left",shrink=0.02,
main="",ticks=NULL,include.sumx=FALSE,...)
}
\arguments{
\item{x}{Vector of numbers.}
\item{edges}{The number of edges with which to draw a circle.}
\item{radius}{The radius of the sectors.}
\item{col}{The colors with which to fill the sectors.}
\item{align.at}{Where to align the sectors (see Details).}
\item{max.span}{The angle of the maximal sector in radians. The default
is to scale \samp{x} so that it sums to 2*pi.}
\item{labels}{Labels placed around the sector arcs.}
\item{labelpos}{Optional circumferential positions for the labels.}
\item{label.radius}{How far away from the sectors the labels will
be placed. May be a vector with a radius for each label.}
\item{align}{Position of the alignment of sectors (see Details).}
\item{shrink}{How much to shrink each successive sector in user units.}
\item{main}{Optional title for the plot.}
\item{ticks}{The number of ticks that would appear if the sectors were on
a pie chart. Default is no ticks, TRUE gives the number of ticks equal to
the integer sum of \samp{x}, which is fairly sensible if
\samp{x} is a vector of integers.}
\item{include.sumx}{Whether to include the sum of all \samp{x} values
as the largest sector.}
\item{...}{Additional arguments passed to \samp{polygon}.}
}
\details{
\samp{fan.plot} displays sectors much like a pie chart except that the
sectors are overlapped. this allows the angular extents of the sectors to
be visually compared much more accurately by the viewer. Sectors are plotted
from the largest to the smallest, shrinking the radius of each successive
sector.
When sending output to the postscript device, the resulting image can be
trimmed by changing the values in BoundingBox in the header with a text
editor.
}
\value{
The circumferential positions of the labels in radians. These are
returned in order of decreasing size of the values plotted.
}
\author{Jim Lemon, Anupam Tyagi}
\examples{
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)
}
\keyword{misc}
plotrix/man/color.axis.Rd 0000644 0001762 0000144 00000001307 14011145766 015104 0 ustar ligges users \name{color.axis}
\alias{color.axis}
\title{Display an axis in a specified color}
\usage{
color.axis(side=1,at=NULL,labels=TRUE,axlab=NA,axlab.at=NA,
col=par("fg"),cex.axis=par("cex.axis"),cex=par("cex"))
}
\arguments{
\item{side}{Which axis - see axis.}
\item{at}{Positions for the tick labels.}
\item{labels}{Tick labels.}
\item{axlab}{Optional axis label.}
\item{axlab.at}{Where to position the axis label - defaults to centered.}
\item{col}{Color for the axis.}
\item{cex.axis}{Character expansion for the tick labels.}
\item{cex}{Character expansion for the axis label.}
}
\description{
\samp{color.axis} displays an axis in the specified color.
}
\value{nil}
\author{Jim Lemon}
\keyword{misc}
plotrix/man/makeIntersectList.Rd 0000755 0001762 0000144 00000005465 14011145766 016471 0 ustar ligges users \name{makeIntersectList}
\alias{makeIntersectList}
\title{Count set intersections}
\description{Create a list of set intersections from a matrix of indicators}
\usage{
makeIntersectList(x,xnames=NULL,sep="+")
}
\arguments{
\item{x}{A data frame or matrix where rows represent objects and columns
attributes. A \samp{1} or \samp{TRUE} indicates that the object (row) has
that attribute or is a member of that set (column). \samp{x} can also be
a matrix or data frame in which the first column contains object identifiers
and the second contains attribute codes.}
\item{xnames}{Optional user-supplied names for the attributes of x.}
\item{sep}{A character to use as a separator for attribute labels.}
}
\details{
\samp{makeIntersectList} reads a matrix (or data frame where all values are the
same type) containing dichotomous values (either 0/1 or FALSE/TRUE) or labels
(see next paragraph). In the first type of input, each row represents an object
and each column represents a set. A value of 1 or TRUE indicates that that
object is a member of that set. The function creates a list of vectors that
correspond to all combinations of the sets (set intersections) and inserts the
counts of elements in each combination. If a row of \samp{x} is all zeros,
it will not be counted, but the second last element of the list returned
contains the count of rows in \samp{x} and thus non-members can be calculated.
If a matrix (or data frame where all values are the same type) containing values
other than 0/1 or TRUE/FALSE, it will be passed to \samp{categoryReshape} for
conversion to a data frame as described above. See \samp{categoryReshape} for
details of this.
makeIntersectList combines the set or attribute names to form
intersection names. For the intersection of sets A and B, the name will
be A+B (unless \samp{sep} is changed) and so on. These are the names that will
be displayed by \samp{intersectDiagram}. To change these, use the \samp{xnames}
argument.
}
\value{
A list of the intersection counts or percentages, the total number of
objects and the attribute codes.
}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{intersectDiagram}, \link{pasteCols},\link{categoryReshape}}
\examples{
# create a matrix where each row represents an element and
# a 1 (or TRUE) in each column indicates that the element is a member
# of that set.
setdf<-data.frame(A=sample(c(0,1),100,TRUE,prob=c(0.7,0.3)),
B=sample(c(0,1),100,TRUE,prob=c(0.7,0.3)),
C=sample(c(0,1),100,TRUE,prob=c(0.7,0.3)),
D=sample(c(0,1),100,TRUE,prob=c(0.7,0.3)))
makeIntersectList(setdf)
ns<-sample(1:8,20,TRUE)
objects<-0
for(i in 1:length(ns)) objects<-c(objects,rep(i,ns[i]))
attributes<-"Z"
for(i in 1:length(ns)) attributes<-c(attributes,sample(LETTERS[1:8],ns[i]))
setdf2<-data.frame(objects[-1],attributes[-1])
makeIntersectList(setdf2)
}
plotrix/man/battleship.plot.Rd 0000644 0001762 0000144 00000004264 14011145766 016144 0 ustar ligges users \name{battleship.plot}
\alias{battleship.plot}
\title{Display a matrix of values as the widths of stacked rectangles}
\usage{
battleship.plot(x,mar=c(2,5,5,1),col="white",border="black",
main="",xlab="",ylab="",xaxlab=NULL,yaxlab=NULL,cex.labels=1,
maxxspan=0.45,maxyspan=0.45)
}
\arguments{
\item{x}{A matrix or data frame containing numeric values. See the example.}
\item{mar}{Margins for the plot.}
\item{col}{The fill colors for the rectangles.}
\item{border}{The border colors for the rectangles.}
\item{main}{The title for the plot (i.e. \samp{main}).}
\item{xlab,ylab}{The x and y axis labels.}
\item{xaxlab,yaxlab}{Optional labels for the rows and columns.}
\item{cex.labels}{Character expansion for the row and column labels.}
\item{maxxspan,maxyspan}{Scaling factor for the widths and heights of the
rectangles so that they don't overlap.}
}
\description{
\samp{battleship.plot} displays a matrix of rectangles, with widths
proportional to the values in \samp{x}. The values are scaled so that half the
width of the largest rectangle is equal to \samp{maxxspan} in user units. This
prevents the rectangles from overlapping. The user can adjust the spacing of the
stacks of rectangles by changing \samp{maxxspan}. Similarly, maxyspan controls
the spacing between rectangles in the vertical direction.
The labels for each stack of plots (the columns of x) are displayed at the top
of the plot, angled at 45 degrees. The labels for each row of rectangles in the
stacks (the rows of x) are displayed at the left. Long labels for either may
require adjusting the \samp{mar} argument.
The function will try to extract the labels \samp{xaxlab} and \samp{yaxlab} from
the matrix column and row names respectively if none are passed.
}
\value{nil}
\author{Jim Lemon - thanks to Adam Maltese for the suggestion}
\keyword{misc}
\seealso{\link{plot}, \link{staxlab}}
\examples{
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)
}
plotrix/man/pie3D.Rd 0000755 0001762 0000144 00000007706 14011145766 014003 0 ustar ligges users \name{pie3D}
\alias{pie3D}
\title{Display a 3D pie chart}
\description{
Displays a 3D pie chart with optional labels.
}
\usage{
pie3D(x,edges=NA,radius=1,height=0.1,theta=pi/6,start=0,border=par("fg"),
col=NULL,labels=NULL,labelpos=NULL,labelcol=par("fg"),labelcex=1.5,
sector.order=NULL,explode=0,shade=0.8,mar=c(4,4,4,4),pty="s",...)
}
\arguments{
\item{x}{a numeric vector for which each value will be a sector}
\item{edges}{the number of lines forming an ellipse}
\item{radius}{the radius of the pie in user units}
\item{height}{the height of the pie in user units}
\item{theta}{The angle of viewing in radians}
\item{start}{The angle at which to start drawing sectors.}
\item{border}{The color of the sector border lines}
\item{col}{The colors of the sectors}
\item{labels}{Optional labels for each sector}
\item{labelpos}{Optional positions for the labels (see examples)}
\item{labelcol}{The color of the labels}
\item{labelcex}{The character expansion factor for the labels}
\item{sector.order}{Allows the operator to specify the order in
which the sectors are drawn.}
\item{explode}{The amount to "explode" the pie in user units}
\item{shade}{If > 0 and < 1, the proportion to reduce the
brightness of the sector color to get a better 3D effect.}
\item{mar}{Margins around the pie.}
\item{pty}{Whether to force a square plot region or not. (see Details)}
\item{...}{graphical parameters passed to \samp{plot}}
}
\value{
The bisecting angle of the sectors in radians.
}
\details{
\samp{pie3D} scales the values in \samp{x} so that they total 2*pi,
dropping zeros and NAs. It then displays an empty plot, calculates
the sequence for drawing the sectors and calls \samp{draw.tilted.sector}
to draw each sector. If labels are supplied, it will call \samp{pie3D.label}
to place these outside each sector. If supplied, the number of labels, label
positions and sector colors must be at least equal to the number of values
in \samp{x}. If the labels are long, it may help to reduce the radius of
the pie or change the position as in the example below.
In order to make the dimensions of the pie reasonably accurate, a square plot
region (\samp{pty="s"}) is the default. If \samp{pty} is set to "m", the user
can change the margins, usually resulting in a non-square plot area. This will
probably distort the pie somewhat.
}
\note{
Due to the somewhat primitive method used to draw sectors, a sector that
extends beyond both pi/2 and 3*pi/2 radians in either direction may not
display properly. Setting \samp{start} to pi/2 will often fix this, but
the user may have to adjust \samp{start} and the order of sectors in extreme
cases. The argument \samp{sector.order} allows the user to specify a vector
of integers that will override the calculation of the order in which the
sectors are drawn. This is usually necessary when a very large sector that
extends past 3*pi/2 is overlapped by a smaller sector next to it. As a last
resort, the user can try setting \samp{explode} to zero. This only draws
the top and outer sides of each sector.
Also due to the sector drawing method, setting \samp{theta} to values smaller
than about pi/8 or larger than about pi/4 will produce obviously misaligned
sectors.
Contributed fixes and improvements:
thanks to Jesse Brown for the "shade" fix and Qinghua Zhao for alerting me to
the problem with labels and margins
}
\author{Jim Lemon}
\seealso{\link{pie3D.labels}, \link{draw.tilted.sector}}
\examples{
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")
# lengthen the last label and move it to the left
pielabels[4]<-"We cannot survive without our pies"
lp[4]<-4.8
# specify some new colors
pie3D(pieval,radius=0.9,labels=pielabels,explode=0.1,main="3D PIE OPINIONS",
col=c("brown","#ddaa00","pink","#dd00dd"),labelpos=lp)
}
\keyword{misc}
plotrix/man/joyPlot.Rd 0000644 0001762 0000144 00000004245 14011145766 014467 0 ustar ligges users \name{joyPlot}
\alias{joyPlot}
\title{Display a series of density curves.}
\usage{
joyPlot(x,mar=c(5,4,4,2),newrange=c(0,1),border=NA,fill=NULL,
main="",xlab="",ylab="",xlim=NA,line_labels=names(x),xat=NULL,
xaxlab=NULL)
}
\arguments{
\item{x}{A list of density curves or other objects with x and y values.}
\item{mar}{Margins for the plot.}
\item{newrange}{Passed to \samp{rescale} to scale the values to fit the
bands on the plot. See Details.}
\item{border}{The border colors for the polygons.}
\item{fill}{Optional fill colors for the polygons.}
\item{main}{Text for the title for the plot.}
\item{xlab,ylab}{The x and y axis labels.}
\item{xlim}{Optional limit for the x axis as \samp{density} returns
values outside the range of the values in \samp{x}.}
\item{line_labels}{Labels for the lines/polygons dieplayed.}
\item{xat}{Optional custom x tick positions.}
\item{xaxlab}{Optional custom x tick labels.}
}
\description{
\samp{joyPlot} displays a matrix of density curves or other two
component lists whose names are \samp{x} and \samp{y}. The labels for
each line/polygon are displayed on the left axis of the plot.
The labels default to the names of the components of \samp{x} if these
are present.
}
\details{
The density curves or other x/y lists will be scaled so that the largest
will fit into the one user unit band allocated for each curve by default.
If the second value of \samp{newrange} is changed, the heights of the
curves will change proportionately. See the third exampls.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{plot}, \link{stackpoly}}
\examples{
x1<-c(sample(20:50,20),sample(40:80,30))
x2<-c(sample(10:40,30),sample(50:90,30))
x3<-sample(20:90,50)
xdens1<-density(x1)
xdens2<-density(x2)
xdens3<-density(x3)
joyPlot(list(xdens1,xdens2,xdens3),main="joyPlot with lines",
xlab="Position",xlim=c(0,100))
xlist<-list(first=xdens1,second=xdens2,third=xdens3)
joyPlot(xlist,main="joyPlot with polygons",xlab="Position",
fill=c("#ffcccc","#ccffcc","#ccccff"),xlim=c(0,100))
joyPlot(xlist,main="joyPlot with overlapping polygons",
fill=c("#ffcccc","#ccffcc","#ccccff"),xlim=c(0,100),
newrange=c(0,1.5),xlab="Position")
}
\keyword{misc}
plotrix/man/radial.grid.Rd 0000644 0001762 0000144 00000002655 14011145766 015212 0 ustar ligges users \name{radial.grid}
\alias{radial.grid}
\title{Display a radial grid}
\usage{
radial.grid(labels=NA,label.pos=NULL,radlab=FALSE,radial.lim=NULL,
start=0,clockwise=FALSE,label.prop=1.1,grid.pos=seq(0.25,1,0.25),
rad.col="gray",grid.col="gray",grid.bg="transparent",show.radial.grid=TRUE,
start.plot=FALSE)
}
\arguments{
\item{labels}{The labels to display around the circumference of the grid.}
\item{label.pos}{Radial positions for the labels.}
\item{radlab}{Whether to rotate the labels to a radial orientation.}
\item{radial.lim}{Optional radial limits for the circular plot. If specified,
these must be the same as the radial limits of the original plot.}
\item{start}{The zero position on the plot in the units of \samp{label.pos}.}
\item{clockwise}{Whether to increase angles clockwise rather than the
default counterclockwise.}
\item{label.prop}{Proportion of \samp{radial.lim} to place the labels.}
\item{grid.pos}{Radial positions for the circular grid lines.}
\item{rad.col}{Color for the radial grid lines.}
\item{grid.col}{Color for the circumferential grid lines.}
\item{grid.bg}{Background color for the radial grid.}
\item{show.radial.grid}{Whether to display the radial lines on the grid.}
\item{start.plot}{If TRUE, sets up a blank radial grid.}
}
\description{
\samp{radial.grid} displays a radial grid for the \samp{radial.plot} and
\samp{radial.pie} functions.
}
\value{nil}
\author{Jim Lemon}
\keyword{misc}
plotrix/man/rescale.Rd 0000755 0001762 0000144 00000002103 14011145766 014437 0 ustar ligges users \name{rescale}
\title{Scale numbers into a new range}
\description{Scale a vector or matrix of numbers into a new range.}
\usage{
rescale(x,newrange)
}
\alias{rescale}
\arguments{
\item{x}{A numeric vector, matrix or data frame.}
\item{newrange}{The minimum and maximum value of the range into which
\samp{x} will be scaled.}
}
\details{
\samp{rescale} performs a simple linear conversion of \samp{x} into the
range specified by \samp{newrange}. Only numeric vectors, matrices or data
frames with some variation will be accepted. NAs are now preserved -
formerly the function would fail.
}
\value{On success, the rescaled object, otherwise the original object.}
\author{Jim Lemon}
\examples{
# scale one vector into the range of another
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))
# now plot them
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")
}
\keyword{misc}
plotrix/man/get.gantt.info.Rd 0000755 0001762 0000144 00000001730 14011145766 015653 0 ustar ligges users \name{get.gantt.info}
\alias{get.gantt.info}
\title{Gather the information to create a Gantt chart}
\description{
Allows the user to enter the information for a Gantt chart.
}
\usage{
get.gantt.info(format="\%Y/\%m/\%d")
}
\arguments{
\item{format}{the format to be used in entering dates/times. Defaults to
YYYY/mm/dd. See \link{strptime} for various date/time formats.}
}
\value{
The list used to create the chart. Elements are:
\item{labels}{The task labels to be displayed at the left of the chart.}
\item{starts,ends}{The task starts/ends as POSIXct dates/times.}
\item{priorities}{Task priorities as integers in the range 1 to 10.
There can be less than 10 levels of priority, but if priorities do
not start at 1 (assumed to be the highest), the default priority colors
will be calculated from 1.}
}
\author{Jim Lemon}
\seealso{\link{gantt.chart}}
\examples{
cat("Enter task times using HH:MM (hour:minute) format\n")
get.gantt.info("\%H:\%M")
}
\keyword{misc}
plotrix/man/starPie.Rd 0000644 0001762 0000144 00000006247 14011145766 014442 0 ustar ligges users \name{starPie}
\alias{starPie}
\title{A pie-like graphic object}
\usage{
starPie(x,y,radext,values,maxval=NA,border=par("fg"),col=NA,prop.area=FALSE,
label="",labelpos=1)
}
\description{
Display a polygon with each sector proportional to a vector of numeric values.
}
\arguments{
\item{x,y}{The coordinate position for the center of the starPie.}
\item{radext}{The maximum distance from the center of the starPie to one vertex of
the polygon.}
\item{values}{A vector of numeric values.}
\item{maxval}{A maximum value for scaling the values to the radius. If NA, the
maximum value in \samp{values} will be used.}
\item{border}{The color to use for the borders of the polygon sectors.}
\item{col}{The color(s) to use for the fills of the polygon.}
\item{prop.area}{Whether to scale the values to the area (TRUE) or the
radial extent (FALSE) of the polygon sectors.}
\item{label}{Optional text labels for the starPies.}
\item{labelpos}{Positions of the labels relative to the starPies.}
}
\value{nil}
\details{
\samp{starPie} displays a polygon centered on the \samp{x,y} position having
sectors of equal angular extent. The radial extent of each sector
is proportional to the values in the numeric vector \samp{lengths}. If the
\samp{prop.area} argument is TRUE, the proportion is based on the area of the
sector, and if \samp{prop.area} is FALSE, the proportion is on the radial extent.
As the function is intended to exaggerate the differences between different
starPies, the default produces sectors proportional to the squares of the
\samp{lengths}.
\samp{starPie} is intended to display a visual analog of the relative value of
matched attributes of a number of similar objects or groups. Thus objects having
similar attributes will produce similar looking starPies. When constructing such
a matrix, it is necessary for \samp{maxval} to be specified, usually as the
overall maximum value in any of the attribute value vectors. If \samp{maxval} is
not specified in such a situation, only the relative values within each vector
will determine the radial extents of each starPie. There appears to be no reason
to have different sector colors for different objects, but the user can display
more than one set of starPies on a plot with different sector colors if
necessary.
\samp{starPie} calls \samp{getYmult} to automatically adjust for both the aspect
and coordinate ratio of the plot.
}
\author{Jim Lemon}
\examples{
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"]]))
}
\keyword{misc}
plotrix/man/barlabels.Rd 0000644 0001762 0000144 00000003764 14011145766 014763 0 ustar ligges users \name{barlabels}
\alias{barlabels}
\title{Label the bars on a barplot}
\description{Displays labels on a plot, usually a bar plot.}
\usage{
barlabels(xpos,ypos,labels=NULL,cex=1,prop=0.5,miny=0,offset=0,nobox=FALSE,...)
}
\arguments{
\item{xpos}{A vector, matrix or data frame of x positions for the labels.}
\item{ypos}{A vector, matrix or data frame of y values for the labels.}
\item{labels}{The labels to display. Defaults to the values of ypos.}
\item{cex}{Relative size of the labels. See \samp{text}.}
\item{prop}{The proportion of \samp{ypos} at which to place the labels.
Defaults to 0.5 (the middle).}
\item{miny}{The minimum value at which to display labels.}
\item{offset}{Amount to horizontally offset successive labels in case
of vertical overlaps.}
\item{nobox}{Whether to call samp{boxed.labels} or \samp{text}.}
\item{...}{Extra arguments passed to \samp{boxed.labels} or \samp{text}.}
}
\details{
\samp{barlabels} places labels on a plot at horizontal positions \samp{xpos}
and vertical positions \samp{ypos} * \samp{prop}. The typical use of this
function is to place labels on bars, by default in the middle of the bars.
To put labels just over the tops of the bars, set \samp{prop} to 1 and add a
constant amount to \samp{ypos}.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{boxed.labels}}
\examples{
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)
# now with stacked bars and offsets
heights<-matrix(sample(c(1,2,10,15),20,TRUE),ncol=4)
barpos<-barplot(heights,main="A redundant stacked bar plot")
barlabels(barpos,heights,offset=0.1)
# do it again without stacking
barpos<-barplot(heights,main="An unstacked redundant bar plot",
beside=TRUE)
barlabels(barpos,heights)
# finally use barp for the plot
barpos<-barp(heights,main="A fourth and final bar plot",col=2:6,
names.arg=paste("Day",1:4))
barlabels(barpos$x,barpos$y,matrix(LETTERS[1:5],nrow=5,ncol=4))
}
\keyword{misc}
plotrix/man/mtext3d.Rd 0000755 0001762 0000144 00000001104 14011145766 014411 0 ustar ligges users \name{mtext3d}
\alias{mtext3d}
\title{ Display text in the margins of a 3D plot }
\description{
Display text in the margins of a 3D plot.
}
\usage{
mtext3d(edge,pmat,labels=TRUE,at=NULL,dist=0.3,xpd=NA,...)
}
\arguments{
\item{edge}{ which axis to calculate.}
\item{pmat}{ matrix to transform coordinates. }
\item{labels}{ labels to display in the margin. }
\item{at}{ position on the axis. }
\item{dist}{ Offset of the axis. }
\item{xpd}{ set clipping for display. }
\item{...}{ additional arguments passed to ptext3d. }
}
\value{nil}
\author{Ben Bolker}
\keyword{misc}
plotrix/man/centipede.plot.Rd 0000755 0001762 0000144 00000010050 14011145766 015736 0 ustar ligges users \name{centipede.plot}
\alias{centipede.plot}
\title{Display a centipede plot}
\description{
Displays a centipede plot on the current graphics device.
}
\usage{
centipede.plot(segs,mct="mean",lower.limit="std.error",
upper.limit=lower.limit,left.labels=NULL,right.labels=NULL,sort.segs=TRUE,
main="",xlab=NA,pch=21,vgrid=NA,hgrid=NA,gridcol="lightgray",mar=NA,col=par("fg"),
bg="green",...)
}
\arguments{
\item{segs}{a matrix of midpoints and limits calculated by
\link{get.segs} OR a \samp{dstat} object returned by
\samp{brkdn}.}
\item{mct}{The function to use in calculating the midpoint of each
segment.}
\item{lower.limit}{The functions to use in calculating the
lower limits for each subset of the data.}
\item{upper.limit}{The functions to use in calculating the
upper limits.}
\item{left.labels}{The variable or subset labels to place at the left margin of
the plot. Default values are provided.}
\item{right.labels}{The variable or subset labels to place at the right margin
of the plot.}
\item{sort.segs}{Whether to sort the segments in ascending order.}
\item{main}{Optional title for the plot.}
\item{xlab}{Optional x axis label for the plot. The default NA
displays a text label showing the midpoint and limit functions.}
\item{pch}{The symbols to use when plotting midpoints.}
\item{vgrid}{Optional vertical line(s) to display on the plot. Defaults to
NA (none).}
\item{hgrid}{Optional horizontal grid lines to display on the plot. Defaults
to NA (none).}
\item{gridcol}{The color for the vgrid and hgrid lines.}
\item{mar}{Margin widths for the plot. Defaults to c(4,5,1,4) or
c(4,5,3,4) if there is a title.}
\item{col}{The color(s) of the limit lines and borders of the midpoint
markers.}
\item{bg}{The color(s) to fill the midpoint markers.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\details{
\samp{centipede.plot} displays one or more midpoints and limits as
filled circles with horizontal error bars. It places labels on the left and
right sides of the plot. If these labels are long, it may be necessary to
pass explicit values to the \samp{mar} argument to leave enough room.
The \samp{vgrid} argument is usually used to display an average value for
all of the midpoints. If one or more values are passed in this argument,
they will be displayed as vertical lines spanning the plot. The \samp{hgrid}
argument acts like the \samp{grid} function, drawing dashed horizontal lines
across the plot. If \samp{hgrid=NULL}, these lines will be drawn under the
values displayed, which will be 1 to the number of values on the vertical axis.
The user can pass explicit values if desired. With horizontal and optionally
vertical grid lines, the centipede plot is practically equivalent to a dotplot
with error bars.
Similarly, centipede plots typically have a large number of subsets, and
it may be necessary to start the graphics device with an aspect ratio that
will prevent crowding of the labels when over 30 segments are displayed.
The matrix \samp{segs} may be entered manually or read from a file.
The first row specifies midpoints, the second and third rows the lower
and upper limits respectively and the fourth row the number of valid
observations. If there are no values for number of valid observations,
just pass vector of blank strings with the \samp{right.labels} argument.
If a \samp{dstat} object is passed as \samp{segs}, the function will calculate
the lower and upper values according to the relevant arguments. This type of
plot is also known as a caterpillar plot or a league table.
}
\value{nil.}
\author{Jim Lemon}
\seealso{\link{get.segs}}
\examples{
testcp<-list("",40)
for(i in 1:40) testcp[[i]]<-rnorm(sample(1:8,1)*50)
segs<-get.segs(testcp)
centipede.plot(segs,main="Test centipede plot",vgrid=0)
# now leave out the number of valid observations, pass x labels and no right labels
centipede.plot(segs[1:3,],main="Test centipede plot",vgrid=0,mar=c(4,5,3,2),
left.labels=paste("X",1:40,sep=""),right.labels=rep("",40))
}
\keyword{misc}
plotrix/man/clustered.dotplots.Rd 0000644 0001762 0000144 00000005127 14011145766 016670 0 ustar ligges users \name{clustered.dotplots}
\alias{clustered.dotplots}
\title{Display the frequencies of two categories}
\usage{
clustered.dotplots(xgroup, ygroup, freq, type = "circles",
main="",xlab="",ylab="",x_las=1,y_las=1,axes=TRUE,size=1,...)
}
\arguments{
\item{xgroup,ygroup}{Vectors that specify the two groupings to be
displayed (see Details).}
\item{freq}{The frequencies in the two groupings.}
\item{type}{The type of symbols to use as "dots".}
\item{main,xlab,ylab}{As in plot.}
\item{x_las,y_las}{Orientation of the axis tick labels.}
\item{axes}{Whether to display axes.}
\item{size}{Spacing for the clusters.}
\item{...}{additional arguments passed to "points".}
}
\description{
\samp{clustered.dotplots} displays a contingency table as clusters of
symbols on a plot. It expects \samp{xgroup} and \samp{ygroup} to contain
all or some of the combinations of their unique values. It also expects
\samp{freq} to contain the number of instances of each combination.
}
\value{nil}
\author{Darshan Baral}
\seealso{\link{cluster.overplot}}
\examples{
df <- structure(list(set = c("09t0101 TJ", "09t0102 MW", "09t0201 EH",
"09t0202 NH", "09t0101 TJ", "09t0102 MW", "09t0201 EH", "09t0202 NH",
"09t0101 TJ", "09t0102 MW", "09t0201 EH", "09t0202 NH", "09t0101 TJ",
"09t0102 MW", "09t0201 EH", "09t0202 NH", "09t0202 NH"), grade = c("1",
"1", "1", "1", "2", "2", "2", "2", "3", "3", "3", "3", "4", "4",
"4", "4", "5"), freq = c(7, 8, 2, 3, 11, 4, 11, 3, 3, 8, 3, 8,
3, 9, 3, 2, 5)), .Names = c("set", "grade", "freq"), row.names = c(NA,
17L), class = "data.frame")
clustered.dotplots(xgroup = df$set, ygroup = df$grade, freq = df$freq)
clustered.dotplots(xgroup = df$set, ygroup = df$grade, freq = df$freq,
col = "gray")
clustered.dotplots(xgroup = df$set, ygroup = df$grade, freq = df$freq,
type = "points")
clustered.dotplots(xgroup = df$set, ygroup = df$grade, freq = df$freq,
type = "points", pch = 19, col = "red")
# this will cause an error
# clustered.dotplots(xgroup = mtcars$cyl, ygroup = mtcars$gear,
# freq = mtcars$carb)
# how to fix it
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)
}
\keyword{misc}
plotrix/man/binciW.Rd 0000644 0001762 0000144 00000001573 14011145766 014243 0 ustar ligges users \name{binciW}
\alias{binciW}
\title{Binomial confidence limits}
\description{
Calculates binomial confidence limits using the Wilson approximation.
}
\usage{
binciW(x,n,alpha=0.05,cc=FALSE)
}
\arguments{
\item{x}{The number of successes or failures for which the CI is to be calculated.}
\item{n}{The number of trials as above.}
\item{alpha}{The desired coverage - 0.05 produces 95 percent coverage}
\item{cc}{Whether to apply a continuity correction}
}
\details{
\samp{binciW} calculates binomial confidence limits for the
given number of successes and trials. It is mainly to allow binomial
confidence limits to be calculated in the \samp{brkdnNest} function,
which is why the upper and lower CIs are called separately.
}
\value{The lower and upper binomial confidence limits}
\author{Jim Lemon}
\seealso{\link{binciWl}, \link{binciWu}}
\examples{
binciW(5,42)
}
\keyword{misc}
plotrix/man/death_reg.Rd 0000644 0001762 0000144 00000000344 14011145766 014745 0 ustar ligges users \name{death_reg}
\alias{death_reg}
\title{Death registrations from 1996 to 2010}
\description{
Death registrations for underlying cause of death as ICD-10 chapters for 1996
to 2010.
}
\usage{
data(death_reg)
}
\keyword{misc}
plotrix/man/radialtext.Rd 0000644 0001762 0000144 00000006146 14011145766 015172 0 ustar ligges users \name{radialtext}
\alias{radialtext}
\title{Display text in a radial line}
\description{
Displays a string in a radial line, rotating it to flow in the radial
direction and optionally scaling each letter's size according to its
distance from the center.
}
\usage{
radialtext(x, center=c(0,0), start=NA, middle=1, end=NA, angle=0,
deg=NA, expand=0, stretch=1, nice=TRUE, cex=NA, ...)
}
\arguments{
\item{x}{A character string.}
\item{center}{The center of the circular area in x/y user units.}
\item{start}{The starting distance of the string from the center in
x/y user units.}
\item{middle}{The middle distance of the string from the center in
x/y user units.}
\item{end}{The ending distance of the string from the center in
x/y user units.}
\item{angle}{The angular position of the string in radians.}
\item{deg}{The angular position of the string in degrees
(takes precedence if not NA).}
\item{expand}{Size expansion factor for characters, used only if
\samp{start} specified.}
\item{stretch}{How much to stretch the string for appearance, 1 for none.}
\item{nice}{TRUE to auto-flip text to keep it upright, FALSE to let
it be upside down.}
\item{cex}{The overall character expansion factor, NA for par("cex").}
\item{...}{Additional arguments passed to \samp{text}.}
}
\value{nil}
\details{
This may not work on all devices, as not all graphic devices can rotate text to
arbitrary angles. The output looks best on a Postscript or similar device that can
rotate text without distortion. Rotated text often looks very ragged on small bitmaps.
If the user passes a value for \samp{start}, this will override a value for
\samp{middle} or \samp{end}. Likewise, a value for \samp{end} will override a
value for \samp{middle}. Also, a value for \samp{deg} overrides any value passed
to \samp{angle}. If \samp{expand} is 0, all characters will be the same size,
while a value of 1 will scale characters so that one that is twice
as far from the center will be twice as large. Negative values are permitted too,
but \samp{expand} is only used if \samp{start} was specified.
}
\author{Ted Toal}
\seealso{\link{text}, \link{arctext}}
\examples{
plot(0, xlim=c(1,5), ylim=c(1,5), main="Test of radialtext",
xlab="", ylab="", type="n")
points(3, 3, pch=20)
radialtext("uncooked spaghetti", center=c(3,3),
col="blue")
radialtext("uncooked spaghetti", center=c(3,3),
start=1.2, angle=pi/4, cex=0.8)
radialtext("uncooked spaghetti", center=c(3,3),
middle=1.2, angle=pi/4+0.1, cex=0.8)
radialtext("uncooked spaghetti", center=c(3,3),
end=1.2, angle=pi/4+0.2, cex=0.8)
radialtext("uncooked spaghetti", center=c(3,3),
start=0.5, deg=135, cex=0.8, col="green")
radialtext("uncooked spaghetti", center=c(3,3),
start=0.5, deg=145, cex=0.8, stretch=2)
radialtext("uncooked spaghetti", center=c(3,3),
start=0.5, deg=20, expand=0, col="red")
radialtext("uncooked spaghetti", center=c(3,3),
start=0.5, deg=250, expand=0.35)
radialtext("uncooked spaghetti", center=c(3,3),
start=0.75, deg=225, expand=1, col="gold")
radialtext("uncooked spaghetti", center=c(3,3),
start=0.5, deg=325, expand=-0.25, cex=2)
}
\keyword{misc}
plotrix/man/binciWl.Rd 0000755 0001762 0000144 00000001435 14011145766 014417 0 ustar ligges users \name{binciWl}
\alias{binciWl}
\title{Lower binomial confidence limit}
\description{
Returns the lower binomial confidence limit using the Wilson approximation.
}
\usage{
binciWl(x,n,alpha=0.05,trueval=TRUE,na.rm=TRUE)
}
\arguments{
\item{x}{The number of successes or failures for which the CI is to be calculated.}
\item{n}{The number of trials as above.}
\item{alpha}{The desired coverage - 0.05 produces 95 percent coverage}
\item{trueval}{The value representing the outcome of interest for the CI.}
\item{na.rm}{Argument needed to make this work}
}
\details{
\samp{binciWl} now calls \samp{binciW} and returns the lower limit.
}
\value{The lower binomial confidence limit}
\author{Jim Lemon}
\seealso{\link{binciWu}}
\examples{
binciWl(c(rep(5,TRUE),rep(37,FALSE)))
}
\keyword{misc}
plotrix/man/color.legend.Rd 0000755 0001762 0000144 00000006034 14011145766 015403 0 ustar ligges users \name{color.legend}
\alias{color.legend}
\title{Legend matching categories or values to colors}
\description{Display a color legend on a plot}
\usage{
color.legend(xl,yb,xr,yt,legend,rect.col,cex=1,align="lt",gradient="x",...)
}
\arguments{
\item{xl,yb,xr,yt}{The lower left and upper right coordinates of the
rectange of colors in user coordinates.}
\item{legend}{The labels that will appear next to some or all of the colors.}
\item{rect.col}{The colors that will fill the rectangle.}
\item{cex}{Character expansion factor for the labels.}
\item{align}{How to align the labels relative to the color rectangle.}
\item{gradient}{Whether to have a horizontal (x) or vertical (y) color
gradient.}
\item{...}{Additional arguments passed to \samp{text}.}
}
\value{nil}
\details{
\samp{color.legend} displays a rectangle defined by the first four arguments
filled with smaller rectangles of color defined by the \samp{rect.col} argument.
Labels, defined by the \samp{legend} argument, are placed next to the color
rectangle. The position of the labels is determined by whether the color
rectangle is horizontal or vertical and the \samp{align} argument. The default
value of \samp{lt} places the labels at the left of a vertical rectangle or the
top of a horizontal one. \samp{rb} puts them on the other side. To have the
labels in the same color as the rectangles, include a \samp{col} argument that
will be passed to \samp{text} as in the example.
There can be fewer labels than colors. The labels will be evenly spaced along
the rectangle in this case. It is possible to use empty labels to get uneven
spacing. The user can pass more labels than colors, but the labels will almost
certainly be crowded and I have only found one use for this. If the user wants
the labels at the intersection of the boxes rather than in the center, see the
alternative specification for the labels in the example (thanks Claudia Tebaldi).
To have complete control over the labels, see \link{gradient.rect} and
\link{text} or \link{mtext}.
\samp{colorlegend} in the \pkg{shape} package offers a different approach,
creating a large number of colors from a color generating function (a bit
like \samp{color.gradient}) and then allowing the user to specify tick
marks at arbitrary points along the color bar.
}
\author{Jim Lemon}
\seealso{\link{color.gradient}, \link{gradient.rect}}
\examples{
# 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))
}
\keyword{misc}
plotrix/man/ladderplot.Rd 0000755 0001762 0000144 00000004464 14011145766 015167 0 ustar ligges users \name{ladderplot}
\Rdversion{1.1}
\alias{ladderplot}
\alias{ladderplot.default}
\title{
Ladder Plot
}
\description{
Makes a ladder plot, similar to \link[MASS]{parcoord} but with more
flexibility and graphical options.
}
\usage{
ladderplot(x, ...)
\method{ladderplot}{default}(x, scale=FALSE, col=1, pch=19, lty=1,
xlim=c(0.5, ncol(x) + 0.5), ylim=range(x), vertical = TRUE, ordered=FALSE,...)
}
\arguments{
\item{x}{
A matrix or data frame with at least 2 columns.
}
\item{scale}{
Logical, if the original data columns should be scaled to the unit (0-1) interval.
}
\item{col}{
Color values to use for rows of \samp{x}. If longer than 1, its value is recycled.
}
\item{pch}{
Point type to use. If longer than 1, its value is recycled.
}
\item{lty}{
Line type to use. If longer than 1, its value is recycled.
}
\item{xlim, ylim}{
Limits for axes.
}
\item{vertical}{
Logical, if the orientation of the ladderplot should be vertical or horizontal.
}
\item{ordered}{
Logical, if the columns in \samp{x} should be ordered.
}
\item{\dots}{
Other arguments passed to the function \link{stripchart}.
}
}
\details{
The function uses \link{stripchart} to plot 1-D scatter plots for each column
in \samp{x}. Then points are joined by lines for each rows of \samp{x}.
}
\value{
Makes a plot as a side effect.
Returns \samp{NULL} invisibly.
}
\author{
Peter Solymos
}
\seealso{
\link{lines}, \link{points}, \link{stripchart}
Almost identical function: \link[MASS]{parcoord}
}
\examples{
x<-data.frame(A=c(1:10), B=c(2:11)+rnorm(10))
y<-data.frame(x, C=c(1:10)+rnorm(10))
opar <- par(mfrow=c(1,3))
ladderplot(x)
ladderplot(x, col=1:10, vertical=FALSE)
ladderplot(y, col=1:10)
par(opar)
## examples from parcoord
\dontrun{
if (require(MASS)) {
opar <- par(mfrow=c(2,3))
z1 <- state.x77[, c(7, 4, 6, 2, 5, 3)]
parcoord(z1, main="parcoord state.x77")
ladderplot(z1, pch=NA, scale=TRUE, main="ladderplot state.x77 original")
ladderplot(z1, main="ladderplot state.x77 original")
ir <- rbind(iris3[,,1], iris3[,,2], iris3[,,3])
z2 <- log(ir)[, c(3, 4, 2, 1)]
parcoord(z2, col = 1 + (0:149))
ladderplot(z2, scale=TRUE, col = 1 + (0:149),
main="ladderplot iris original")
ladderplot(z2, col = 1 + (0:149))
par(opar)
}
}
}
\keyword{ aplot }
plotrix/man/smoothColors.Rd 0000755 0001762 0000144 00000002315 14011145766 015521 0 ustar ligges users \name{smoothColors}
\alias{smoothColors}
\title{Build a vector of color values}
\usage{
smoothColors(...,alpha=NA)
}
\arguments{
\item{...}{an arbitrary sequence of color names and integers beginning
and ending with a color name.}
\item{alpha}{optional \samp{alpha} (transparency) value.}
}
\description{
\samp{smoothColors} calculates a sequence of colors. If two color names
in the arguments are separated by a number, that number of interpolated
colors will be inserted between the two color endpoints. Any number of
color names and integers may be passed, but the last argument must be
a color name. If more than one integer appears between two color names,
only the first will be used in the interpolation and the others will be
ignored.
}
\value{A vector of hexadecimal color values as used by \samp{col}.}
\note{
For more R functions that transform numeric values into
colors or produce colors that can be used to represent values, see the
\pkg{colourschemes} package.
}
\author{Barry Rowlingson}
\seealso{\link{color.gradient},\link{rgb}}
\examples{
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"))
}
\keyword{misc}
plotrix/man/polygon.shadow.Rd 0000755 0001762 0000144 00000004546 14011145766 016011 0 ustar ligges users \name{polygon.shadow}
\alias{polygon.shadow}
\title{Display a shadow effect for an arbitrary polygon}
\description{
Displays a shadow effect on an existing plot
}
\usage{
polygon.shadow(x,y=NULL,offset=NA,inflate=NA,col=c("#ffffff","#cccccc"))
}
\arguments{
\item{x,y}{x and y coordinate of the vertices of the polygon. \samp{y}
can be missing if \samp{x} is a list with \samp{x} and \samp{y} components.}
\item{offset}{a vector containing the values of the x and y offsets for the
shadow. Defaults to 1/20 of the maximum x and y dimensions of the polygon.}
\item{col}{the colors of the shadow from the outer edge to the central part.}
\item{inflate}{the amount to "inflate" the shadow relative to the polygon
(i.e. the penumbra). Defaults to the values in \samp{offset}.}
}
\value{nil}
\details{
\samp{polygon.shadow} is typically called just before drawing a polygon.
It displays a shadow effect by drawing the polygon ten times, beginning
with the first color in \samp{col} and stepping through to the second
color to create a "shadow" (or a "halo" if you prefer). Each successive
polygon is shrunk by 10\% of \samp{inflate}. The default shadow effect has
the light at the upper left. This effect may also be used as a text
background.
}
\note{
The background must be a constant color or the shadow effect will not
look right. A good starting point for the two colors is the color of the
background and the RGB components of that color multiplied by 0.8. Use a
smaller multiplier for a darker shadow.
}
\author{Jim Lemon}
\seealso{\link{polygon}}
\examples{
par(pty="s")
plot(1:5,type="n",main="Polygon Shadow test",xlab="",ylab="",axes=FALSE)
box()
# do a shadow on a yellow square
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"))
# a green triangle on a light blue square with a big offset
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"))
# now a circle as a background
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)
}
\keyword{misc}
plotrix/man/sizetree.Rd 0000644 0001762 0000144 00000013223 14011145766 014655 0 ustar ligges users \name{sizetree}
\alias{sizetree}
\title{Display a hierarchical breakdown of disjunct categories}
\description{Display a data frame in which the values in each successive
column represent subcategories of the previous column as stacked
rectangles.}
\usage{
sizetree(x,left=0,top,right=1,lastcenter=NA,showval=TRUE,showcount=TRUE,
stacklabels=TRUE,firstcall=TRUE,col=NULL,border=NA,toplab=NULL,base.cex=1,
...)
}
\arguments{
\item{x}{A data frame in which each successive column represents
subcategories of the previous column.}
\item{left}{The left edge of the current stack of rectangles in user units.}
\item{top}{The top of the current stack of rectangles in user units.}
\item{right}{The right edge of the current stack of rectangles in user units.}
\item{lastcenter}{The center of the previous rectangle from which the next
breakdown of categories arises. There is almost no reason to change it.}
\item{showval}{Whether to display the values representing the categories.}
\item{showcount}{Whether to display the count for the categories.}
\item{stacklabels}{Whether to display the names of the dataframe beneath
the stacked rectangles.}
\item{firstcall}{A flag for the function - do not alter this.}
\item{col}{Optional fill colors for the rectangles. See Details}
\item{border}{Color for border around the rectangles. See details}
\item{toplab}{Optional labels to display a the top of each stack.}
\item{base.cex}{The base character expansion for the labels.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\value{ nil }
\details{
\samp{sizetree} displays disjunct hierarchical categories as stacked rectangles.
It accepts a data frame in which the values in the first column represent
categories, the values in the second column represent subcategories of the
first column, and so on. The first column will be displayed as a stack of
rectangles, the height of each proportional to the count for each category.
Each substack of rectangles in the second stack will represent the breakdown
of counts for its superordinate category and so on through the columns.
Empty categories are ignored and NAs will produce gaps, which will propagate
across subsequent stacks.
The user can simply pass the data frame, which should only contain columns that
are hierarchical categories (example 1). The colors will probably not be ideal.
The user can pass the same colors for the all levels (example 2). If this is
done, \samp{sizetree} will try to match colors to categories when
the number of categories is diminishing (e.g. some levels are missing in the
sub-categories) and the columns of \samp{x} are factors with the same levels in
the same order. This will work if the category labels are the same in each level,
but remember to add the names to the colors before passing them to the function.
This will not work if there are more categories in the lower levels. If \samp{col}
is a list, this is not done, and the user will have to work out the correct colors
for each level. This is particularly important when the category labels and the
number of categories is different in different levels (example 3).
In some sizetrees, the subcategory counts are very low compared to the overall
number of data objects. This results in rectangles that are very thin vertically.
One way to get better legibility of the labels is to use dark colors for the
rectangles, so that the labels are white, and no borders (set \samp{border} to NA).
The user can also select only part of the data frame \samp{x} to expand sections
of the sizetree as in the last example.
The labels are sized to fit the vertical extent of the bars. However, it is
possible that the labels may extend horizontally beyond the bar(s). The
\samp{base.cex} argument can be used to shrink the labels if this happens.
Remember that \samp{base.cex} will shrink all the labels, not just the ones
that are too wide.
The \samp{firstcall} argument is necessary for the function to initialize the
plot, as each breakdown involves a recursive call. If it is changed, the best
that can be expected is an uninformative plot.
}
\author{Jim Lemon}
\seealso{\link{plot}}
\examples{
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")
# now see what happens with a list of the same colors for each level
bhcol<-c("#ff8080","#dddd80","#80ff80","#0000ff","#80dddd")
sizetree(hcats,col=list(bhcol,bhcol,bhcol),
main="Sizetree with the same colors each level")
# finally, specify different colors for categories with different labels
sexhaireye<-data.frame(sex=factor(sample(c("Male","Female"),50,TRUE)),
hair=factor(sample(c("Blond","Red","Brown","Black"),50,TRUE)),
eye=factor(sample(c("Gold","Green","Blue"),50,TRUE)))
shecol<-list(c("pink","lightblue"),c("#000000","#dddd00","#886600","#ee8800"),
c("blue","gold","green"))
sizetree(sexhaireye,main="Sex, hair and eye color",
col=shecol,toplab=c("Sex","Hair color","Eye color"))
# now expand the female part of the sizetree
sizetree(sexhaireye[sexhaireye[,1]=="Female",],
main="Sex, hair and eye color (Females only)",
col=shecol,toplab=c("Sex","Hair color","Eye color"))
}
\keyword{misc}
plotrix/man/kiteChart.Rd 0000755 0001762 0000144 00000011654 14011145766 014752 0 ustar ligges users \name{kiteChart}
\alias{kiteChart}
\title{ Magnitude by position chart. }
\description{
Display numeric values as the widths of a polygon along a dimension such as time.
}
\usage{
kiteChart(x,xlim=NA,ylim=NA,timex=TRUE,main="Kite chart",
xlab=ifelse(timex,"Time","Groups"),ylab=ifelse(timex,"Groups","Time"),
border=par("fg"),col=NULL,varpos=NA,varlabels=NA,varscale=FALSE,
timepos=NA,timelabels=NA,mar=c(5,4,4,4),axlab=c(1,2,3,4),
normalize=FALSE,shownorm=TRUE,...)
}
\arguments{
\item{x}{Numeric matrix or data frame}
\item{xlim}{Horizontal extent of the chart. Defaults to 1:dim(x)[2].}
\item{ylim}{Vertical extent of the chart. Defaults to 0.5:dim(x)[1]+0.5.}
\item{timex}{Whether the "time" axis is x (horizontal) or not.}
\item{main,xlab,ylab}{As in \samp{plot}.}
\item{border}{The border color(s) for the polygons.}
\item{col}{The fill colors for the polygons.}
\item{varpos}{Optional positions for the "kite lines". Defaults to 1:dimx[1].
(see Details)}
\item{varlabels}{Labels for the rows of values - defaults to the rownames,
or if these are missing, varpos[1:dim(x)[1]].}
\item{varscale}{Whether to show the maximum extent of each "kite line".}
\item{timepos}{The positions of the values along the x axis, usually times,
defaulting to 1:dim(x)[2].}
\item{timelabels}{Labels for the positions, defaulting to \samp{timepos}.}
\item{mar}{Plot margins. These leave space for the normalization multipliers
on the right or top side (see Details).}
\item{axlab}{Where to put axis tick labels and multipliers. See Details.}
\item{normalize}{Whether to scale each row of values to a maximum width of 1.}
\item{shownorm}{Whether to display the normalization multipliers.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\details{
\samp{kiteChart} displays each row of \samp{x} as a sequence of widths, allowing
the relationships between those values and the dimension along which they occur
(usually time) to be illustrated.
The values in x are scaled to a maximum polygon width of 1 if \samp{normalize}
is TRUE. This is to avoid overlapping of the polygons. There may be some cases
where the values can be displayed directly. If normalized, the multipliers will
be displayed for each row on the right or top side of the chart unless \samp{shownorm}
is FALSE. Remember to specify the \samp{mar} argument if more space at the top
is needed.
The \samp{axlab} argument allows the user to place the axis tick labels and
normalization multipliers on different axes. The default places the tick labels
on the bottom and left sides of the plot and the multipliers on the right or top.
Using \samp{axlab=c(3,4,1,2)} places the tick labels on the top and right and the
multipliers on the left or bottom. The \samp{mar} argument may have to be adjusted.
The user can display raw values by default, or by setting \samp{varpos} to TRUE.
Setting \samp{varpos} to a vector of positions will place the "kite lines" on those
values. If there are no row names and the \samp{varlabels} argument is NA, the values
of \samp{varpos} will be used as labels for each "kite line". The maximum extent of
each "kite line" can be displayed by setting \samp{varscale} to TRUE. If
\samp{varscale} is TRUE, one extra line will be added to the top margin. If
\samp{varpos[1]} is not NA, \samp{normalize} is FALSE by default.
}
\value{The values of \samp{mar} that were current when \samp{kiteChart} was called.}
\author{Jim Lemon (Thanks to Michael Bedward for suggestions on the arguments and
Nikolaus Lampadariou for the suggestions on displaying raw values)}
\seealso{\link{polygon}}
\examples{
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)
# now show it with kite line maxima
kiteChart(testmat,varlabels=c("Uniform","Sample","Normal","Sine"),
timepos=seq(1,50,by=5),timex=FALSE,varscale=TRUE)
mtext("Sine",at=65,side=1,line=2)
musicmat<-matrix(c(c(0.5,0.4,0.3,0.25,0.2,0.15,0.1,rep(0.05,44))+runif(51,0,0.05),
c(0.1,0.2,0.3,0.35,0.4,0.5,0.4,rep(0.5,14),rep(0.4,15),rep(0.3,15))+runif(51,0,0.1),
rep(0.15,51)+runif(51,0,0.1),
c(rep(0,29),c(0.1,0.2,0.4,0.5,0.3,0.2,rep(0.05,16))+runif(22,0,0.05)),
c(rep(0,38),c(rep(0.05,6),0.08,0.15,0.20,0.25,0.2,0.25,0.3)+runif(13,0,0.05))),
ncol=51,byrow=TRUE)
kiteChart(musicmat,varlabels=c("Swing","Rock","Jazz","Disco","Rap"),
main="An utterly imaginary chart of music popularity",
timepos=seq(1,51,by=10),timelabels=seq(1950,2000,by=10),mar=c(5,4,4,2))
# now flip it to vertical, normalize and show the normalization factors
kiteChart(musicmat,varlabels=c("Swing","Rock","Jazz","Disco","Rap"),
main="An utterly imaginary chart of music popularity",xlab="Style",
timepos=seq(1,51,by=10),timelabels=seq(1950,2000,by=10),mar=c(5,4,4,2),
timex=FALSE,normalize=TRUE,shownorm=TRUE)
}
\keyword{misc}
plotrix/man/ruginv.Rd 0000644 0001762 0000144 00000002130 14011145766 014330 0 ustar ligges users \name{ruginv}
\alias{ruginv}
\title{Add an Inverse Rug to a Plot}
\description{Adds a \emph{rug} representation (1D plot) of the data to the plot,
but with the coloring inverted.}
\usage{
ruginv(x,ticksize=0.03,side=1,lwd=0.5,col=par("fg"),col.ticks="white",
quiet=getOption("warn") < 0,...)
}
\arguments{
\item{x}{A numeric vector.}
\item{ticksize}{The length of the ticks making up the 'rug'. Positive lengths
produce inward ticks.}
\item{side}{On which side of the plot box the rug will appear. Usually 1
(bottom) or 3 (top).}
\item{lwd}{The line width of the ticks.}
\item{col}{Color of the background of the ticks.}
\item{col.ticks}{The color of the ticks.}
\item{quiet}{Logical indicating if there should be a warning about clipped
values.}
\item{...}{Further arguments passed to \link{polygon} when plotting the
background for the ticks.}
}
\author{Peter Solymos}
\seealso{\link{rug}}
\examples{
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")
}
\keyword{misc}
plotrix/man/plotCI.Rd 0000755 0001762 0000144 00000006454 14011145766 014230 0 ustar ligges users \name{plotCI}
\alias{plotCI}
\title{Plot confidence intervals/error bars}
\description{
Given a set of x and y values and upper and lower bounds,
this function plots the points with error bars.
}
\usage{
plotCI(x,y=NULL,uiw,liw=uiw,ui=NULL,li=NULL,err="y",
sfrac=0.01,gap=0,slty=par("lty"),add=FALSE,scol=NULL,pt.bg=par("bg"),...)
}
\arguments{
\item{x}{The x coordinates of points in the plot}
\item{y}{The y coordinates of points in the plot}
\item{uiw}{The width of the upper portion of the confidence region,
or (if \samp{liw} is missing) the width of both halves of
the confidence region}
\item{liw}{The width of the lower portion of the confidence region (if
missing, the function assumes symmetric confidence bounds)}
\item{ui}{The absolute upper limit of the confidence region}
\item{li}{The absolute lower limit of the confidence region}
\item{err}{The direction of error bars: "x" for horizontal, "y"
for vertical ("xy" would be nice but is not implemented yet; don't
know quite how everything would be specified. See examples for
composing a plot with simultaneous horizontal and vertical error bars)}
\item{gap}{Size of gap in error bars around points
(default 0;gap=TRUE gives gap size of 0.01)}
\item{sfrac}{Scaling factor for the size of the "serifs" (end bars) on
the confidence bars, in x-axis units}
\item{add}{If FALSE (default), create a new plot; if TRUE, add error
bars to an existing plot.}
\item{slty}{Line type of error bars}
\item{scol}{Color of error bars: if \samp{col} is specified in the
optional arguments, \samp{scol} is set the same; otherwise it's set
to \samp{par(col)}}
\item{pt.bg}{Background color of points (use pch=21, pt.bg=par("bg")
to get open points superimposed on error bars)}
\item{\dots}{Any other parameters to be passed through to
\link{plot.default}, \link{points},
\link{arrows}, etc. (e.g. \samp{lwd}, \samp{col}, \samp{pch},
\samp{axes}, \samp{xlim}, \samp{ylim}). \samp{xlim} and
\samp{ylim} are set by default to include all of the data points and
error bars. \samp{xlab} and \samp{ylab} are set to the names of
\samp{x} and \samp{y}. If \samp{pch==NA}, no points are drawn
(e.g. leaving room for text labels instead)}
}
\value{
invisible(x,y); creates a plot on the current device.
}
\author{Ben Bolker (documentation and tweaking of a function provided by
Bill Venables, additional feature ideas from Gregory Warnes)}
\seealso{\link{boxplot}}
\examples{
y<-runif(10)
err<-runif(10)
plotCI(1:10,y,err,main="Basic plotCI")
plotCI(1:10,y,err,2*err,lwd=2,col="red",scol="blue",
main="Add colors to the points and error bars")
err.x<-runif(10)
err.y<-runif(10)
plotCI(1:10,y,err.y,pt.bg=par("bg"),pch=21,xlim=c(0,11),
main="plotCI with extra space on the x axis")
plotCI(1:10,y,err.x,pt.bg=par("bg"),pch=21,err="x",add=TRUE)
mtext("for adding horizontal error bars",3,0.5)
data(warpbreaks)
attach(warpbreaks)
wmeans<-by(breaks,tension,mean)
wsd<-by(breaks,tension,sd)
## note that barplot() returns the midpoints of the bars, which plotCI
## uses as x-coordinates
plotCI(barplot(wmeans,col="gray",ylim=c(0,max(wmeans+wsd))),wmeans,wsd,add=TRUE)
## using labels instead of points
labs<-sample(LETTERS,replace=TRUE,size=10)
plotCI(1:10,y,err,pch=NA,gap=0.02,main="plotCI with labels at points")
text(1:10,y,labs)
}
\keyword{hplot}
plotrix/man/thigmophobe.labels.Rd 0000755 0001762 0000144 00000005312 14011145766 016574 0 ustar ligges users \name{thigmophobe.labels}
\title{Place labels away from the nearest point}
\usage{
thigmophobe.labels(x,y,labels=NULL,text.pos=NULL,...)
}
\alias{thigmophobe.labels}
\arguments{
\item{x,y}{Numeric data vectors or a list with two components.
Typically the x/y coordinates of plotted points.}
\item{labels}{A vector of strings that will be placed adjacent to
each point. Defaults to the indices of the coordinates.}
\item{text.pos}{An optional vector of text positions (see
\link{text}).}
\item{...}{additional arguments are passed to \samp{text}}.
}
\description{
\samp{thigmophobe.labels} places labels adjacent to each point,
offsetting each label in the direction returned by
\samp{thigmophobe}.
}
\details{
Typically used to automatically place labels on a scatterplot or
similar to avoid overlapping labels. \samp{thigmophobe.labels}
will sometimes place a label off the plot or fail to separate
labels in clusters of points. The user can manually adjust the
errant labels by running \samp{thigmophobe} first and saving
the returned vector. Then modify the position values to place
the labels properly and pass the edited vector to
\samp{thigmophobe.labels} as the \samp{text.pos} argument. This
takes precedence over the positions calculated by \samp{thigmophobe}.
\samp{thigmophobe} will fail with only two labels, as it can't figure out
the nearest neighbors. If you really want to use this with two labels, just
eyeball the plot and work out in which direction the labels will go. Then
pass the directions to \samp{thigmophobe.labels} as the \samp{text.pos}
argument. When all else fails, look to samp{placeLabels}.
Both \samp{pointLabel} in the \pkg{maptools} package and \samp{spread.labs}
in the \pkg{TeachingDemos} package use more sophisticated algorithms to
place the labels and are worth a try if \samp{thigmophobe} just won't get it
right.
}
\value{
A vector of directions away from the point nearest to each point.
}
\keyword{misc}
\author{Jim Lemon (thanks to Stephen Milborrow for finding the single point bug
and Erik Aronesty for finding the two point problem.)}
\seealso{\link{thigmophobe}, \link{text}}
\examples{
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")
# skip the almost invisible yellow label, make them bold
thigmophobe.labels(x,y,plotlabels,col=c(2:6,8:12),font=2)
}
plotrix/man/draw.tilted.sector.Rd 0000755 0001762 0000144 00000002743 14011145766 016552 0 ustar ligges users \name{draw.tilted.sector}
\alias{draw.tilted.sector}
\title{Display a 3D pie sector}
\description{
Displays a 3D pie sector.
}
\usage{
draw.tilted.sector(x=0,y=0,edges=NA,radius=1,height=0.1,theta=pi/6,
start=0,end=pi*2,border=par("fg"),col=par("bg"),explode=0,shade=0.8)
}
\arguments{
\item{x,y}{Position of the center of the pie sector in user units}
\item{edges}{Number of edges to draw a complete ellipse}
\item{radius}{the radius of the pie in user units}
\item{height}{the height of the pie in user units}
\item{theta}{The angle of viewing in radians}
\item{start}{Starting angle of the sector}
\item{end}{Ending angle of the sector}
\item{border}{The color of the sector border lines}
\item{col}{Color of the sector}
\item{explode}{How far to "explode" the sectors in user units}
\item{shade}{If > 0 and < 1, the proportion to reduce the
brightness of the sector color to get a better 3D effect.}
}
\value{
The bisector of the pie sector in radians.
}
\details{
\samp{draw.tilted.sector} displays a single 3D pie sector. It is probably
only useful when called from \link{pie3D}. The \samp{shade}
argument proportionately reduces the brightness of the RGB color of
the sector to produce a top lighted effect.
If \samp{explode} is zero, only the top and outer side of each
sector will be displayed. This will sometimes fix the problem of a pie with
one huge sector greater than 3*pi/2 that cannot otherwise be drawn.
}
\author{Jim Lemon}
\seealso{\link{pie3D}}
\keyword{misc}
plotrix/man/feather.plot.Rd 0000755 0001762 0000144 00000004121 14011145766 015416 0 ustar ligges users \name{feather.plot}
\alias{feather.plot}
\title{ Display vectors along a horizontal reference line }
\description{
Displays vectors along a line usually representing time or position.
}
\usage{
feather.plot(r,theta,xpos,yref=0,use.arrows=TRUE,
col.refline="lightgray",fp.type="s",main="",xlab="",ylab="",
xlabels=NULL,...)
}
\arguments{
\item{r}{radii of vectors}
\item{theta}{direction of vectors in radians}
\item{xpos}{where to start each vector along the reference line}
\item{yref}{vertical position to place the reference line}
\item{use.arrows}{whether to put arrow heads on the ends of the vectors}
\item{col.refline}{the color of the reference line}
\item{fp.type}{whether to use "standard" coordinates (begin at the
right and move counterclockwise) or "meteorological" coordinates
(begin at the top and move clockwise) when interpreting the values
of \samp{theta}}
\item{main}{the title of the plot}
\item{xlab}{the label for the reference line}
\item{ylab}{the label for the vertical axis}
\item{xlabels}{optional labels for the reference line}
\item{...}{additional arguments passed to \samp{arrows} or \samp{segments}}
}
\details{
This function places vectors of length \samp{r} and angle \samp{theta}
along a reference line that may represent time or position or some other
value. The user is responsible for spacing the vectors so that they do
not overlap if this is desired.
Feather plots are typically wider than high. The user will probably want
to specify a graphics device that doesn't leave lots of blank space above
and below the plot.
}
\value{nil}
\author{Jim Lemon, Eduardo Klein}
\seealso{\link{spread.labels}}
\examples{
dev.new(width=8,height=3)
r<-0.6+rnorm(24)/5
theta<-c(seq(15*pi/16,pi/16,length.out=12),
seq(17*pi/16,31*pi/16,length.out=12))
feather.plot(r,theta,xlabels=1:24,
main="Standard Coordinates",xlab="Time",ylab="Value")
# rearrange theta for meteorological coordinates
feather.plot(r,c(theta[19:24],rev(theta[7:18]),theta[1:6]),xlabels=1:24,fp.type="m",
main="Meteorological Coordinates",xlab="Time",ylab="Value")
dev.off()
}
\keyword{misc}
plotrix/man/gantt.chart.Rd 0000755 0001762 0000144 00000012503 14011145766 015243 0 ustar ligges users \encoding{latin1}
\name{gantt.chart}
\alias{gantt.chart}
\title{Display a Gantt chart}
\description{
Displays a Gantt chart with priority coloring
}
\usage{
gantt.chart(x=NULL,format="\%Y/\%m/\%d",xlim=NULL,taskcolors=NULL,
priority.legend=FALSE,vgridpos=NULL,vgridlab=NULL,
vgrid.format="\%Y/\%m/\%d",
half.height=0.25,hgrid=FALSE,main="",xlab="",cylindrical=FALSE,
label.cex=1,border.col=NA,priority.label="Priorities",
priority.extremes=c("High","Low"),time.axis=3)
}
\arguments{
\item{x}{a list of task labels, start/end times and task priorities
as returned by \samp{get.gantt.info}. If this is not present,
\link{get.gantt.info} will be called.}
\item{format}{the format to be used in entering dates/times
(see \link{strptime}).}
\item{xlim}{the horizontal limits of the plot (see Details).}
\item{taskcolors}{a vector of colors used to illustrate task priority.}
\item{priority.legend}{Whether to display a priority color legend.}
\item{vgridpos}{optional positions of the vertical grid lines.}
\item{vgridlab}{optional labels for the vertical grid lines.}
\item{vgrid.format}{format for the vertical grid labels.}
\item{half.height}{the proportion of the spacing between task bars that
will be filled by the bar on each side - 0.5 will leave no space.}
\item{hgrid}{logical - whether to display grid lines between the bars.}
\item{main}{the title of the plot - note that this is actually displayed
using \samp{mtext}.}
\item{xlab}{horizontal axis label - usually suppressed.}
\item{cylindrical}{Whether to give the bars a cylindrical appearance.}
\item{label.cex}{Relative size for the task labels at the left side.}
\item{border.col}{The color for an optional border for the bars (NA=none).}
\item{priority.label}{Label for the priority color legend.}
\item{priority.extremes}{Labels for each end of the priority color legend.}
\item{time.axis}{Where to place the time axis labels.}
}
\value{
The list used to create the chart - see \link{get.gantt.info} for
details. This can be saved and reused rather than manually entering the
information each time the chart is displayed.
}
\details{
Because the "time" axis is calculated using POSIXct values, the
values passed as \samp{xlim} must also be POSIXct. See the second plot
in the examples.
If task priority colors are not wanted, set \samp{taskcolors} to a single
value to suppress the coloring. If this is not done, \samp{rainbow} will
be called to generate a different color for each task. If colors other than
\samp{rainbow} are wanted, remember to pass enough colors for one to the
lowest (highest numerically) priority.
There can now be more than one time interval for each task. If there is,
more than one bar will be displayed for each interval, which may not be a
task at all, but rather intervals related to the labels. Colors can be
specified for labels or intervals and if there are not as many colors as
intervals, the first "number of unique labels" colors will be assigned to
each unique label. This should make every bar for each label the
same color, but be aware that the colors will be distributed in alphabetical
order of the entity labels. If there are at least as many taskcolors as intervals,
they will be assigned to intervals in the order of the \samp{taskcolors} vector.
The examples should make this clearer.
Since \samp{gantt.chart} can be used to display things other than prioritized
tasks, the labels for the priority legend can now be specified.
}
\author{Jim Lemon (original by Scott Waichler - features by Ulrike Gromping -
added label colors by Nicolas Immelman)}
\seealso{\link{get.gantt.info}}
\examples{
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)
# add a little extra space on the right side
gantt.chart(gantt.info,main="Calendar date Gantt chart (2004)",
priority.legend=TRUE,vgridpos=vgridpos,vgridlab=vgridlab,hgrid=TRUE,
xlim=as.POSIXct(strptime(c("2004/01/01","2004/12/20"),
format=Ymd.format)))
# if both vgidpos and vgridlab are specified,
# starts and ends don't have to be dates
info2<-list(labels=c("Jim","Joe","Jim","John","John","Jake","Joe","Jed","Jake"),
starts=c(8.1,8.7,13.0,9.1,11.6,9.0,13.6,9.3,14.2),
ends=c(12.5,12.7,16.5,10.3,15.6,11.7,18.1,18.2,19.0))
gantt.chart(info2,vgridlab=8:19,vgridpos=8:19,
main="All bars the same color",taskcolors="lightgray")
gantt.chart(info2,vgridlab=8:19,vgridpos=8:19,
main="A color for each label",taskcolors=c(2,3,7,4,8))
gantt.chart(info2,vgridlab=8:19,vgridpos=8:19,
main="A color for each interval - with borders",
taskcolors=c(2,3,7,4,8,5,3,6,"purple"),border.col="black")
}
\keyword{misc}
plotrix/man/bumpchart.Rd 0000755 0001762 0000144 00000006522 14011145766 015017 0 ustar ligges users \name{bumpchart}
\alias{bumpchart}
\title{Display a "bumps" (sequential ranking) chart}
\description{
Display a chart with two of more columns of points in order of ascending values
with lines connecting the points in a row.
}
\usage{
bumpchart(y,top.labels=colnames(y),labels=rep(rownames(y),2),rank=TRUE,
mar=c(2,8,5,8),pch=19,col=par("fg"),lty=1,lwd=1,arrows=FALSE,...)
}
\arguments{
\item{y}{A numeric matrix or data frame which may contain NAs.}
\item{top.labels}{The strings that will appear at the top of each column of
points on the plot.}
\item{labels}{The strings that will appear next to the outer columns of
points.}
\item{rank}{Whether to rank the values in \samp{y} before plotting.}
\item{mar}{The margins to use for the bumps chart. Alter to your taste.}
\item{pch}{The symbols to use when plotting the points.}
\item{col}{The colors to use.}
\item{lty}{The line types to use.}
\item{lwd}{The line widths to use.}
\item{arrows}{Whether to join the points with lines (FALSE) or arrows (TRUE).}
\item{...}{Additional arguments passed to \samp{matplot} or \samp{arrows}.}
}
\details{
\samp{bumpchart} calls \samp{matplot} to plot the values in the transposed
\samp{y} matrix or data frame, joining the points with lines. At the left and
right edges of the plot, the labels identifying each row of points are
displayed. These labels may now be different for each side of the plot,
for example if the values of \samp{y} are to be included. Remember that
due to the transposition of the values for plotting, the labels on the
right have to precede those on the left - see the second example.
This type of plot is often used to show the changing positions of
entities over time, like the ranking in surveys in different years. For a
similar, but more flexible plot, see \link{ladderplot}.
Because of the way \samp{matplot} plots the values, the order of everything is
reversed. As the typical display of ranks is with rank 1 at the top, the
actual rank positions are used to plot the values.
This places the lowest scores at the bottom of the plot and the highest at
the top.
Any arguments that are included in \samp{...} will be passed to \samp{matplot}
if the \samp{arrows} argument is FALSE, and to the \samp{arrows} function if
the \samp{arrows} argument is TRUE as in the first example.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{matplot}}
\examples{
# percentage of those over 25 years having completed high school
# in 10 cities in the USA in 1990 and 2000
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,main="Rank for high school completion by over 25s",
arrows=TRUE,length=0.2)
vallab<-c(paste(educattn[,2],rownames(educattn),sep="-"),
paste(rownames(educattn),educattn[,1],sep="-"))
# now show the raw percentages and add central ticks
bumpchart(educattn,rank=FALSE,labels=vallab,
main="Percentage high school completion by over 25s",
lty=1:10,lwd=1,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)
}
\keyword{misc}
plotrix/man/axis.mult.Rd 0000755 0001762 0000144 00000003427 14011145766 014757 0 ustar ligges users \name{axis.mult}
\alias{axis.mult}
\title{ Display an axis with values having a multiplier }
\description{
An axis is displayed on an existing plot where the tick values are divided
by a multiplier and the multiplier is displayed next to the axis.
}
\usage{
axis.mult(side=1,at=NULL,labels,mult=1,mult.label,mult.line,
mult.labelpos=NULL,...)
}
\arguments{
\item{side}{which side to display}
\item{at}{where to place the tick marks - defaults to \samp{axTicks()}}
\item{labels}{tick labels - defaults to at/mult}
\item{mult}{the multiplier factor}
\item{mult.label}{the label to show the multiplier - defaults to "x mult"}
\item{mult.line}{the margin line upon which to show the multiplier}
\item{mult.labelpos}{where to place \samp{mult.label} - defaults to centered
and outside the axis tick labels}
\item{...}{additional arguments passed to \samp{axis}.}
}
\value{nil}
\details{
\samp{axis.mult} automates the process of displaying an axis with a
multiplier applied to the tick values. By default it will divide the
default axis tick labels by \samp{mult} and place \samp{mult.label}
where \samp{xlab} or \samp{ylab} would normally appear. Thus the plot
call should set the relevant label to an empty string in such cases.
It is simplest to call \samp{plot} with \samp{axes=FALSE} and then
display the box and any standard axes before calling \samp{axis.mult}.
}
\note{
While \samp{axis.mult} will try to display an axis on any side, the top
and right margins will require adjustment using \samp{par} for
\samp{axis.mult} to display properly.
}
\author{Jim Lemon}
\seealso{\link{axis}, \link{mtext}}
\examples{
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)
}
\keyword{misc}
plotrix/man/getYmult.Rd 0000644 0001762 0000144 00000001125 14011145766 014633 0 ustar ligges users \name{getYmult}
\alias{getYmult}
\title{Correct for aspect and coordinate ratio}
\description{Calculate a multiplication factor for the Y dimension to correct
for unequal plot aspect and coordinate ratios on the current graphics device.}
\usage{
getYmult()
}
\details{
\samp{getYmult} retrieves the plot aspect ratio and the coordinate ratio for
the current graphics device, calculates a multiplicative factor to equalize
the X and Y dimensions of a plotted graphic object.
}
\value{The correction factor for the Y dimension.}
\author{Jim Lemon}
\seealso{\link{draw.circle}}
\keyword{misc}
plotrix/man/histStack.Rd 0000644 0001762 0000144 00000005672 14011145766 014771 0 ustar ligges users \name{histStack}
\alias{histStack}
\alias{histStack.formula}
\alias{histStack.default}
\title{Histogram "stacked" by categories}
\description{
Histogram of a quantitative variable with bars that are "stacked" by the
values of a factor variable.
}
\usage{
histStack(x,...)
\method{histStack}{formula}(x,data,breaks="Sturges",col="rainbow",
right=TRUE,main="",xlab=NULL,legend.pos=NULL,cex.legend=0.75,...)
\method{histStack}{default}(x,z,breaks="Sturges",col="rainbow",
right=TRUE,main="",xlab=NULL,legend.pos=NULL,cex.legend=0.75,...)
}
\arguments{
\item{x}{A vector of quantitative data or a formula of the form x~z
(see z below).}
\item{z}{A vector of categorical data (a factor) that will define the
\dQuote{stacks}.}
\item{data}{A data frame that contains both x and z.}
\item{breaks}{Breaks to use in categorizing values of x.}
\item{col}{Either a vector of colors in any legitimate form or a
character string that specifies a function that requires only the length
of the vector as an argument and will return a vector of colors with that
length. (see Details)}
\item{right}{A logical that indicates whether the bins are right-open
(left-closed; =TRUE) or right-closed (left-open; =FALSE; default).}
\item{main}{A character string that forms the main title for the plot.}
\item{xlab}{A character string for labeling the x-axis.}
\item{legend.pos}{A character string or two numeric values indicating the
position for the stacking legend.}
\item{cex.legend}{A numeric character expansion value for the legend.
Values less than 1 will make the legend smaller.}
\item{...}{Additional arguments sent to the hist function.}
}
\details{
\samp{histStack} displays a \dQuote{stacked histogram} while using many of
the same arguments as hist(). The argument \samp{z} will be converted to a
factor with a warning if it is not already a factor.
The color functions in \pkg{grDevices} (e.g. "gray.colors") should always
be valid when passed as the \samp{col} argument. Any function that will
return a vector of \samp{n} colors when called with a single argument
\samp{n} and that exists in the current environment should work. An error
will occur if length(col)==1 and the value is not a function as described
for \samp{col} (e.g., \samp{col="blue"} will result in an error).If fewer
colors than levels of \samp{z} are passed, they will be recycled.
}
\value{nil. A plot is displayed.}
\note{
This function is currently experimental.
}
\author{Derek Ogle with modifications by Jim Lemon}
\seealso{\link{hist}, \link{legend}}
\examples{
set.seed(409)
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")
histStack(len~grp,data=df,col="heat.colors",main="Heat colors",
xlab="Length category",legend.pos="topright")
histStack(len~grp,data=df,col=2:5,main="Colors by number",
xlab="Length category",legend.pos=c(2.8,18))
}
\keyword{misc}
plotrix/man/sliceArray.Rd 0000644 0001762 0000144 00000001435 14011145766 015123 0 ustar ligges users \name{sliceArray}
\alias{sliceArray}
\title{Slice an array}
\description{
Slices one dimension from an array by taking one element from the first dimension.
}
\usage{
sliceArray(x,slice)
}
\arguments{
\item{x}{An array}
\item{slice}{The index of the slice to take from the first dimension of the array.}
}
\details{
\samp{sliceArray} builds an extractor string containing the value of \samp{slice}
as the first element and as many commas as needed to match the dimensions of the
array. It then applies the extractor function to \samp{x} and returns the result.
Note how the array "slice" swaps dimensions in the example.
}
\value{
The desired slice of the array.
}
\author{Jim Lemon}
\seealso{\link{array}}
\examples{
a1<-array(1:27,dim=c(3,3,3))
a1
sliceArray(a1,2)
}
\keyword{misc}
plotrix/man/psegments3d.Rd 0000755 0001762 0000144 00000001010 14011145766 015251 0 ustar ligges users \name{psegments3d}
\alias{psegments3d}
\title{ Draw segments on a 3D plot }
\description{
Draw segments on a 3D plot defined by a list of coordinates
}
\usage{
psegments3d(x,y=NULL,z=NULL,pmat,...)
}
\arguments{
\item{x,y,z}{ x, y and z coordinates to plot. \samp{x} may be a list with
three components.}
\item{pmat}{ matrix to transform coordinates. }
\item{...}{ Other arguments passed to \samp{segments}. }
}
\details{
Draws segments on a perspective plot.
}
\value{nil}
\author{Ben Bolker}
\keyword{misc}
plotrix/man/get.soil.texture.Rd 0000755 0001762 0000144 00000001547 14011145766 016257 0 ustar ligges users \name{get.soil.texture}
\alias{get.soil.texture}
\title{Enter soil texture data}
\usage{
get.soil.texture(use.percentages=FALSE,cnames=c("sand","silt","clay"))
}
\arguments{
\item{use.percentages}{Logical - whether to treat the entries as
percentages and scale to proportions.}
\item{cnames}{column names for the resulting three column matrix.}
}
\description{
\samp{get.soil.texture} calls \samp{get.triprop} to allow the user to
enter soil textures as the proportions or percentages of three
components, sand, silt and clay.
}
\value{A matrix of the components of one or more soil samples.}
\author{Sander Oom and Jim Lemon}
\seealso{\link{soil.texture},\link{get.triprop}}
\examples{
if(dev.interactive()) {
newsp<-get.soil.texture()
# show the soil triangle
soil.texture()
# now plot the observations
show.soil.texture(newsp)
}
}
\keyword{misc}
plotrix/man/pyramid.plot.Rd 0000755 0001762 0000144 00000013773 14011145766 015462 0 ustar ligges users \name{pyramid.plot}
\alias{pyramid.plot}
\title{Pyramid plot}
\description{
Displays a pyramid (opposed horizontal bar) plot on the current
graphics device.
}
\usage{
pyramid.plot(lx,rx,labels=NA,top.labels=c("Male","Age","Female"),
main="",laxlab=NULL,raxlab=NULL,unit="\%",lxcol,rxcol,gap=1,space=0.2,
ppmar=c(4,2,4,2),labelcex=1,add=FALSE,xlim,show.values=FALSE,ndig=1,
do.first=NULL)
}
\arguments{
\item{lx,rx}{Vectors or a matrix or data frame (see Details) which
should be of equal length.}
\item{labels}{Labels for the categories represented by each pair of
bars. There should be a label for each lx or rx value, even if empty.
If \samp{labels} is a matrix or data frame, the first two columns will
be used for the left and right category labels respectively.}
\item{top.labels}{The two categories represented on the left and right
sides of the plot and a heading for the labels in the center.}
\item{main}{Optional title for the plot.}
\item{laxlab}{Optional labels for the left x axis ticks.}
\item{raxlab}{Optional labels for the right x axis ticks.}
\item{unit}{The label for the units of the plot.}
\item{lxcol,rxcol}{Color(s) for the left and right sets of bars. Both of
these default to \samp{rainbow(length(labels))}.}
\item{gap}{One half of the space between the two sets of bars for the
\samp{labels} in user units.}
\item{space}{Space between the bars. Should be 0 <= space < 1.}
\item{ppmar}{Margins for the plot (see Details).}
\item{labelcex}{Expansion for the category labels.}
\item{add}{Whether to add bars to an existing plot. Usually this
involves overplotting a second set of bars, perhaps transparent.}
\item{xlim}{Optional x limit for the plot (see Details).}
\item{show.values}{Whether to display \samp{lx} and \samp{rx} at the
ends of the bars.}
\item{ndig}{The number of digits to round the values if displayed.}
\item{do.first}{Optional expression to evaluate before displaying anything.}
}
\details{
\samp{pyramid.plot} is principally intended for population pyramids,
although it can display other types of opposed bar charts with suitable
modification of the arguments. If the user wants a different unit for
the display, just change \samp{unit} accordingly. The default gap of
two units is usually satisfactory for the four to six percent range
of most bars on population pyramids. If \samp{labels} is a matrix or
data frame of at least two columns, the first column will be displayed
on the on the left side of the gap in the center, and the second on the
right. This will almost always require increasing the gap width and
perhaps also specifying a wider plotting device. Displaying the values
will usually require increasing the left and/or right margins of the
plot, or setting \samp{xlim} larger than the largest value.
If a gap width of zero is passed, the category labels will be displayed
at the left and right extents of the plot. This usually requires setting
\samp{xlim} to values larger than the maximum extent of \samp{lx} and
\samp{rx}. The user can pass two different values to \samp{xlim}, but
this is almost always a bad idea, as the lengths of the bars will not
be in the same proportion to the values on the left and right sides.
Both the bars and category labels are vertically centered on integer
values, allowing the user to easily add components to the plot.
\samp{lx} and \samp{rx} are the values specifying the left and right
extents of the left and right bars respectively. If both are matrices
or data frames, \samp{pyramid.plot} will produce opposed stacked bars
with the first columns innermost. In this mode, colors are limited to
one per column. The stacked bar mode will in general not work with the
\samp{add} method or with a gap of zero. Note that the stacked bar
mode can get very messy very quickly.
The \samp{add} argument allows one or more sets of bars to be plotted
on an existing plot. If these are not transparent, any bar that is
shorter than the bar that overplots it will disappear. Only some graphic
devices (e.g. \samp{pdf}) will handle transparency.
In order to add bars, the function cannot restore the initial margin values
or the new bars will not plot properly. To automatically restore the plot
margins, call the function as in the example.
}
\value{
The return value of \samp{par("mar")} when the function was called.
}
\author{Jim Lemon (thanks to Susumu Tanimura for the patch that omits
ticks for NA values in vector input and Igor Rebeiro for the space
argument)}
\seealso{\link{rect}}
\examples{
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))
# three column matrices
avtemp<-c(seq(11,2,by=-1),rep(2:6,each=2),seq(11,2,by=-1))
malecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
femalecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
# group by age
agegrps<-c("0-10","11-20","21-30","31-40","41-50","51-60",
"61-70","71-80","81-90","91+")
oldmar<-pyramid.plot(malecook,femalecook,labels=agegrps,
unit="Bowls per month",lxcol=c("#ff0000","#eeee88","#0000ff"),
rxcol=c("#ff0000","#eeee88","#0000ff"),laxlab=c(0,10,20,30),
raxlab=c(0,10,20,30),top.labels=c("Males","Age","Females"),gap=4,
do.first="plot_bg(\"#eedd55\")")
# put a box around it
box()
# give it a title
mtext("Porridge temperature by age and sex of bear",3,2,cex=1.5)
# stick in a legend
legend(par("usr")[1],11,c("Too hot","Just right","Too cold"),
fill=c("#ff0000","#eeee88","#0000ff"))
# don't forget to restore the margins and background
par(mar=oldmar,bg="transparent")
}
\keyword{misc}
plotrix/man/add.ps.Rd 0000644 0001762 0000144 00000006546 14011145766 014206 0 ustar ligges users \name{add.ps}
\alias{add.ps}
\title{
add p-values from t-tests
}
\description{
Adds p-values comparing the different cells at each x-axis position with a
reference cell. Uses a syntax similar to \samp{raw.means.plot2}.
}
\usage{
add.ps(data, col.id, col.offset, col.x, col.value, fun.aggregate = "mean",
ref.offset = 1, prefixes,alternative = c("two.sided", "less", "greater"),
mu = 0, paired = FALSE, var.equal = FALSE, lty = 0, ...)
}
\arguments{
\item{data}{
A \samp{data.frame}
}
\item{col.id}{
\samp{character} vector specifying the id column.
}
\item{col.offset}{
\samp{character} vector specifying the offset column.
}
\item{col.x}{
\samp{character} vector specifying the x-axis column.
}
\item{col.value}{
\samp{character} vector specifying the data column.
}
\item{fun.aggregate}{
Function or function name used for aggregating the results. Default is
\samp{"mean"}.
}
\item{ref.offset}{
Scalar \samp{numeric} indicating the reference level to be tested against.
The default is 1 corresponding to \samp{levels(factor(d[,col.offset]))[1]}.
}
\item{prefixes}{
\samp{character} vector of the indices for the p-values. If missing
corresponds to \samp{levels(factor(d.new[,col.offset]))[-ref.offset]}.
}
\item{alternative}{
same as in \link{t.test}
}
\item{mu}{
same as in \link{t.test}
}
\item{paired}{
same as in \link{t.test}
}
\item{var.equal}{
same as in \link{t.test}
}
\item{lty}{
line type of axis, Default is 0 (i.e., no line).
}
\item{\dots}{
further arguments passed to axis.
}
}
\details{
This function computes t-tests comparing the values at each x-axis position
for each condition against the reference condition at and adds the p-values
to the axis.
This functions uses the same syntax as \link{raw.means.plot2} and
should be used in addition to it. Note that values are ordered according to
the \samp{col.id} so \samp{paired = TRUE} should be fine.
}
\value{
axis is plotted.
}
\author{
Henrik Singmann
}
\seealso{
\link{raw.means.plot} as the accompanying main functions.
}
\examples{
\dontrun{
#The examples uses the OBrienKaiser dataset from car and needs reshape.
# This extends the examples from raw.means.plot
require(reshape)
require(car)
data(OBrienKaiser)
OBKnew <- cbind(factor(1:nrow(OBrienKaiser)), OBrienKaiser)
colnames(OBKnew)[1] <- "id"
OBK.long <- melt(OBKnew)
OBK.long[, c("measurement", "time")] <-
t(vapply(strsplit(as.character(OBK.long$variable), "\\\."), "[", c("", "")))
# For this example the position at each x-axis are within-subject comparisons!
raw.means.plot2(OBK.long, "id", "measurement", "gender", "value")
add.ps(OBK.long, "id", "measurement", "gender", "value", paired = TRUE)
#reference is "fup"
raw.means.plot2(OBK.long, "id", "measurement", "gender", "value")
add.ps(OBK.long, "id", "measurement", "gender", "value", ref.offset = 2,
paired = TRUE) #reference is "post"
# Use R's standard (i.e., Welch test)
raw.means.plot2(OBK.long, "id", "treatment", "gender", "value")
add.ps(OBK.long, "id", "treatment", "gender", "value",
prefixes = c("p(control vs. A)", "p(control vs. B)"))
# Use standard t-test
raw.means.plot2(OBK.long, "id", "treatment", "gender", "value")
add.ps(OBK.long, "id", "treatment", "gender", "value", var.equal = TRUE,
prefixes = c("p(control vs. A)", "p(control vs. B)"))
}
}
plotrix/man/get.segs.Rd 0000755 0001762 0000144 00000002065 14011145766 014547 0 ustar ligges users \name{get.segs}
\alias{get.segs}
\title{Calculate the midpoints and limits for a centipede plot}
\description{
Calculates midpoints and limits for a list or data frame for use with
centipede.plot.
}
\usage{
get.segs(x,mct="mean",lower.limit="std.error",upper.limit=lower.limit)
}
\arguments{
\item{x}{a list or data frame.}
\item{mct}{The name of the function to calculate midpoints.}
\item{lower.limit,upper.limit}{The names of the function(s) to calculate
lower and upper limits.}
}
\details{
\samp{get.segs} calls the functions whose names are passed to calculate
midpoints and limits for each list element or data frame column. The
user can define special functions for the central and dispersion measures
if desired.
}
\value{A matrix with four rows and as many columns as were in the object
\samp{x}. The first row contains the midpoint values, the second and third
the lower and upper limit values respectively and the fourth row the number
of valid observations in the columns.}
\author{Jim Lemon}
\seealso{\link{centipede.plot}}
\keyword{misc}
plotrix/man/twoord.plot.Rd 0000755 0001762 0000144 00000015577 14011145766 015337 0 ustar ligges users \name{twoord.plot}
\alias{twoord.plot}
\title{ Plot with two ordinates }
\description{
Two sets of values are displayed on the same plot with different ordinate
scales on the left and right.
}
\usage{
twoord.plot(lx,ly,rx,ry,data=NULL,main="",xlim=NULL,lylim=NULL,rylim=NULL,
mar=c(5,4,4,4),lcol=1,rcol=2,xlab="",lytickpos=NA,ylab="",ylab.at=NA,
rytickpos=NA,rylab="",rylab.at=NA,lpch=1,rpch=2,
type="b",xtickpos=NULL,xticklab=NULL,halfwidth=0.4,axislab.cex=1,
do.first=NULL,xaxt="s",...)
}
\arguments{
\item{lx,ly,rx,ry}{y and optional x values for the plot}
\item{data}{an optional data frame from which to obtain the above values}
\item{main}{Title for the plot}
\item{xlim}{optional x limits as in \samp{plot}}
\item{lylim,rylim}{optional y limits for the left and right axes
respectively}
\item{mar}{optional margin adjustment, defaults to \samp{c(5,4,4,4)}}
\item{lcol,rcol}{colors to distinguish the two sets of values}
\item{xlab}{X axis label as in \samp{plot}}
\item{lytickpos}{Optional positions for the left axis tick labels.}
\item{ylab}{Left Y axis label as in \samp{plot}}
\item{ylab.at}{Optional position for the left Y axis label}
\item{rytickpos}{Optional positions for the right axis tick labels.}
\item{rylab}{Right Y axis label}
\item{rylab.at}{Optional position for the right Y axis label}
\item{lpch,rpch}{plot symbols to distinguish the two sets of values}
\item{type}{as in \samp{plot}}
\item{xtickpos}{Optional positions for x-axis tick labels.}
\item{xticklab}{Optional labels for x-axis. Useful for things like dates.}
\item{halfwidth}{Half the width of the bars in user units. The bars are
centered on successive integers if no \samp{x} values are supplied.}
\item{axislab.cex}{Character expansion for the axis labels and tick labels.}
\item{do.first}{Optional command(s) that will be executed immediately after
the blank plot is displayed.}
\item{xaxt}{Whether to display the x-axis - "n" = no.}
\item{...}{additional arguments passed to \samp{plot} and \samp{points}.}
}
\value{nil}
\details{
\samp{twoord.plot} automates the process of displaying two sets of
values that have different ranges on the same plot. It is principally
useful in illustrating some relationship between the values across the
observations. It is assumed that the \samp{lx} and \samp{rx} values
are at least adjacent, and probably overlapping.
It is best to pass all the arguments \samp{lx, ly, rx, ry}, but the
function will attempt to substitute sensible x values if one or two
are missing.
If at least one of the \samp{type} arguments is "bar", bars will be plotted
instead of points or lines. It is best to plot the bars first (i.e. relative
to the left axis) if the other type is points or lines, as the bars will
usually obscure at least some of the points or lines. Using NA for the color
of the bars will partially correct this. If both types are to be bars,
remember to pass somewhat different x values or the bars will be overplotted.
Note that more values can be added to the plot using \samp{points} or
\samp{lines}, but remember that these will be plotted relative to the left
ordinate.
The \samp{do.first} argument is useful for adding a background color or grid
to the plot as shown in the first two examples.
}
\note{
There are many objections to the use of plots with two different
ordinate scales, and some of them are even sensible and supported by
controlled observation. Many of the objections rest on assertions that the
spatial arrangement of the values plotted will override all other
evidence. Here are two:
The viewer will assume that the vertical position of the data points
indicates a quantitative relationship.
To some extent. It is probably not a good idea to have the spatial
relationship of the points opposed to their numerical relationship. That
is to say, if one set of values is in the range of 0-10 and the other
20-100, it is best to arrange the plot so that the latter values are
not plotted below the former. See the second example, which illustrates
a method for separating the two series and offsetting the axes.
The viewer will assume that an intersection of lines indicates an
intersection of values.
If the visual elements representing values can be arranged to avoid
intersections, so much the better. Many people have no trouble
distinguishing which visual elements are linked to which axis as long as
they are both coded similarly, usually with colors and/or symbols. In the
special case where there is an underlying relationship between the two
such as the probability of that value occurring under some conditions, it
may help to mark the point(s) where this occurs.
It may be useful to consider \samp{gap.plot} or separate plots as an
alternative.
}
\author{Jim Lemon (thanks to Christophe Dutang for the idea of using bars
and lines in the same plot, Clair Crossupton for pointing out that
dates on the x-axis weren't very good, Jacob Kasper for the axis
character expansion and Ye Lin for finally motivating me to add the
do.first argument.)}
\seealso{\link{plot}}
\examples{
xval1 <- seq.Date(as.Date("2017-01-02"),
as.Date("2017-01-10"), by="day")
xval2 <- seq.Date(as.Date("2017-01-01"),
as.Date("2017-01-15"), by="day")
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)")
axis.Date(1,xval2)
# now separate the lines
twoord.plot(2:10,going_up,1:15,going_down,xlab="Sequence",
lylim=range(going_up)+c(-1,10),rylim=range(going_down)+c(-10,2),
ylab="Ascending values",ylab.at=5,rylab="Descending values",
rylab.at=65,lcol=4,main="Plot with two ordinates - separated lines",
lytickpos=3:7,rytickpos=seq(55,75,by=5),
do.first="plot_bg();grid(col=\"white\",lty=1)")
twoord.plot(2:10,going_up,1:15,going_down,xlab="Sequence",
lylim=range(going_up)+c(-1,10),rylim=range(going_down)+c(-10,2),
type=c("bar","l"),ylab="Ascending values",ylab.at=5,
rylab="Descending values",rylab.at=65,
main="Bars on left axis, lines on right axis",
lytickpos=3:7,rytickpos=seq(55,75,by=5),
lcol=3,rcol=4,do.first="plot_bg()")
twoord.plot(2:10,going_up,1:15,going_down,xlab="Sequence",
lylim=c(-3,8),rylim=c(50,100),type=c("l","bar"),
ylab="Ascending values",rylab="Descending values",
lytickpos=3:7,rytickpos=seq(55,75,by=5),ylab.at=5,rylab.at=65,
main="Lines on left axis, bars on right axis",
lcol=3,rcol=4,do.first="plot_bg(\"yellow\")")
# histogram with density curve superimposed
xhist<-hist(rnorm(100),plot=FALSE)
xdens<-dnorm(seq(-3,3,by=0.05))
twoord.plot(xhist$mids,xhist$counts,seq(-3,3,by=0.05),
xdens,type=c("bar","l"),lcol=4,rcol=2,ylab="Counts",
rylab="Density",main="Histogram and density curve",
halfwidth=0.2,lylim=c(0,max(xhist$counts)+1),rylim=c(0,0.45),lwd=2)
}
\keyword{misc}
plotrix/man/l2010.Rd 0000644 0001762 0000144 00000000702 14011145766 013557 0 ustar ligges users \name{l2010}
\alias{l2010}
\title{World lightning strike data from 2010}
\description{
A list of two 50x100 matrices containing most of the world lightning strike
data from 2010. It was produced by \samp{makeDensityMatrix} from 171 file
(about 3 Gb) of data consisting in two geographic coordinates for the
approximate location of each recorded strike and an estimated intensity of the
strike in kVA.
}
\usage{
data(l2010)
}
\keyword{misc}
plotrix/man/brkdnNest.Rd 0000755 0001762 0000144 00000006201 14011145766 014756 0 ustar ligges users \name{brkdnNest}
\alias{brkdnNest}
\title{Perform a nested breakdown of numeric values}
\description{Breaks down a numeric or categorical element of a data frame
by one or more categorical elements.}
\usage{
brkdnNest(formula,data,FUN=c("mean","sd","sd","valid.n"),label1="Overall",
trueval=TRUE)
}
\arguments{
\item{formula}{A formula with a numeric element of a data frame on the left and
one or more categorical elements on the right.}
\item{data}{A data frame containing the elements in \samp{formula}.}
\item{FUN}{The functions to be applied to successive breakdowns.}
\item{label1}{The label to use for the overall value of the first function.}
\item{trueval}{The value to use in calculating proportions or sums of a
categorical response variable. See Details.}
}
\value{
A list with as many elements as there are functions in \samp{FUN}. It is
probably best to always specify four functions (summary measure, upper
dispersion measure, lower dispersion measure and number of valid observations)
even if this is redundant as in the default.
This function is similar to \samp{brkdn} in the \pkg{prettyR} package, but
is structured to be used with the \samp{barNest} function. It produces one
or more measures for the overall data, then the subsets of the data defined by
the first variable to the right of the tilde, then the subsets defined by
the first and second variable, and so on.
}
\details{
\samp{brkdnNest} performs a nested breakdown of an element of a data frame
by one or more categorical elements. For each category and optional
subcategories, the variable on the left of the formula is summarized as
specified by the functions named in \samp{FUN}.
If \samp{trueval} is not NA, brkdnNest will calculate the proportion of
\samp{trueval} values in the response variable out of the total valid
responses. If the function \samp{valid.n} is the first function in
\samp{FUN}, the counts of the groups and subgroups will be returned.
Two specialized summary functions are defined within \samp{brkdnNest}.
\samp{sumbrk} returns the count of values in a factor equal to \samp{trueval},
and \samp{propbrk} returns the proportion of values equal to
\samp{trueval}. Be aware that if a categorical variable is specified on
the left of the formula, functions which expect numeric data such as
\samp{mean} should not be included in \samp{FUN}.
The user should take care when specifying different summary functions.
\samp{barNest} expects a summary measure as the first component of the list
and measures of dispersion as the second and third. If two different measures
of dispersion are passed, the first must calculate the upper and the second
the lower measure.
}
\author{Jim Lemon}
\seealso{\link{by}}
\examples{
brkdntest<-data.frame(Age=rnorm(100,25,10),
Sex=factor(sample(c("M","F"),100,TRUE)),
Marital=sample(c("M","X","S","W"),100,TRUE),
Employ=sample(c("FT","PT","NO"),100,TRUE))
brkdnNest(formula=Age~Sex+Marital+Employ,data=brkdntest)
# show the proportion of unemployed with binomial confidence intervals
brkdnNest(formula=Employ~Sex+Marital,data=brkdntest,
FUN=c("propbrk","binciWu","binciWl"),trueval="NO")
}
\keyword{misc}
plotrix/man/staircasePlot.Rd 0000644 0001762 0000144 00000007344 14011145766 015647 0 ustar ligges users \name{staircasePlot}
\alias{staircasePlot}
\title{Display a staircase plot}
\description{
Displays a plot showing a sequence of changing totals and increments as
successive linked bars.
}
\usage{
staircasePlot(heights,totals=NA,labels=NULL,halfwidth=0.3,main="",mar=NA,
stair.info=list(total.col="blue",inc.col=NA,border=par("fg")),bg.col=NA,
direction="e",las=1,display.height=TRUE,stagger=FALSE,cex=par("cex"),
prefix="",suffix="",...)
}
\arguments{
\item{heights}{vector of numeric values or a matrix or data frame with at least
two columns. The first column must be numeric and the second may be numeric or
logical.}
\item{totals}{A vector of logicals or zero/non-zero values indicating whether
the corresponding height is a total (TRUE) or an increment (FALSE).}
\item{labels}{An optional vector of labels for the bars.}
\item{halfwidth}{Half of the width of a bar as a proportion. See Details.}
\item{main}{A title for the plot.}
\item{mar}{Margins for the plot. Defaults to 10 on the baseline axis, 3 on the
top and 1 on the other two sides.}
\item{stair.info}{A list of arguments for the bars including color(s)
for the bars representing successive totals, and increments and the
border color.}
\item{bg.col}{The background color for the plot.}
\item{direction}{Direction in which the bars should be presented. See Details.}
\item{las}{Orientation for the bar labels. See \samp{par}.}
\item{display.height}{Whether to display the totals and increments at the upper
ends of the bars. Defaults to TRUE.}
\item{stagger}{Whether to stagger the labels to avoid overlap.}
\item{cex}{The usual character expansion value.}
\item{prefix}{A prefix to the numbers displayed next to the bars (e.g. $).}
\item{suffix}{A suffix as for prefix (e.g. \%).}
\item{...}{arguments passed to \samp{plot}.}
}
\value{nil}
\details{
Displays a plot representing successive changes in counts or values. For example,
if a research study attempts to contact a certain number of people and some
cannot be contacted, some decline to participate, some are ineligible, the final
sample will be smaller than the initial contact list. The first value will be the
total of attempts, there will be a number of decrements, and the last value will
be the actual sample. There may be intermediate totals specified. This produces
a visual display of the sampling procedure. See the example.
The bars are placed at integer values on the axis representing the succession of
counts or values. The width of the bars is determined by the argument
\samp{halfwidth}. This defaults to 0.3, meaning that the bar extends 0.3 to each
side, so that the proportion of bar to space is 0.6 to 0.4. The succession of
bars is determined by the \samp{direction} argument. The default is "e" (east),
meaning that the first bar is at the left of the plot and subsequent bars are
placed to the right. The other three possibilities follow the conventional
compass layout.
The \samp{prefix} and \samp{suffix} arguments allow the user to specify units
for the numbers displayed next to the bars. If a single value is passed, all
numbers will get the same prefix or suffix. Different prefixes or suffixes for
each number can be passed as vectors.
The \samp{getFigCtr} function is called to center the plot title in the figure
region as the plot area is typically off center.
}
\author{Jim Lemon}
\seealso{\link{plot}, \link{getFigCtr}}
\examples{
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")
staircasePlot(sample_size,totals,labels,
main="Acquisition of the sample (staircasePlot)",
total.col="gray",inc.col=2:4,bg.col="#eeeebb",direction="s")
}
\keyword{misc}
plotrix/man/color.scale.lines.Rd 0000755 0001762 0000144 00000004423 14011145766 016345 0 ustar ligges users \name{color.scale.lines}
\alias{color.scale.lines}
\title{Line segments with scaled colors}
\description{Display line segments with colors scaled to numeric values.}
\usage{
color.scale.lines(x,y,reds,greens,blues,col=NA,colvar=NA,...)
}
\arguments{
\item{x,y}{Numeric vectors or a list with at least two components,
the first two of which must be named x and y.}
\item{reds,greens,blues}{Color ranges into which to scale the
numeric values.}
\item{col}{One or more colors to use for the resultant lines. Will
be recycled if necessary.}
\item{colvar}{A numeric vector from which to scale the colors.}
\item{...}{Additional arguments passed to \samp{segments}.}
}
\details{
\samp{color.scale.lines} displays line segments that can be individually
colored according to a variety of methods. In order of precedence, if
\samp{col} is not NA, the color values passed will be used. If
\samp{colvar} is not NA, the function will call \samp{color.scale} with
the three color range arguments to determine the line colors. If
\samp{colvar} is the same length as \samp{length(x)-1}, exactly enough
colors for the number of lines displayed will be calculated. If shorter,
some colors will be recycled and if longer, some colors will not be used.
Finally, the values in \samp{y} will be color-scaled if both of the above
arguments are NA. Thus the user can pass predetermined colors, use colors
scaled from an arbitrary vector of numerical values or use the \samp{y}
values. See \samp{color.scale} for an explanation of specifying color
ranges.
}
\note{
The function is useful for highlighting a numeric dimension or adding
an extra "dimension" to a plot.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{color.scale}}
\examples{
# color a random walk "hot" (red) to "cold" (blue) on its distance
# from the starting point
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",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)
# now color the lines to show whether each step went away from
# or toward the starting position
color.scale.lines(x,y,col=2+(diff(xydist)>0))
boxed.labels(x,y,labels=1:100,border=FALSE,cex=0.5)
}
\keyword{misc}
plotrix/man/print.brklist.Rd 0000755 0001762 0000144 00000001441 14011145766 015632 0 ustar ligges users \name{print.brklist}
\alias{print.brklist}
\title{Display the output of brkdnNest}
\description{
Displays the list of values produced by \samp{brkdnNest}.
}
\usage{
\method{print}{brklist}(x,...)
}
\arguments{
\item{x}{a list of summary values produced by \samp{\link{brkdnNest}}}
\item{...}{additional arguments passed to \samp{print}.}
}
\details{
\samp{print.brklist} displays frequency tables produced by \samp{brkdnNest}.
It is mainly for convenience, but does make a nicer display than when passed
directly to \samp{print}
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{brkdnNest}}
\examples{
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)
}
\keyword{misc}
plotrix/man/get_axispos3d.Rd 0000755 0001762 0000144 00000001000 14011145766 015570 0 ustar ligges users \name{get_axispos3d}
\alias{get_axispos3d}
\title{ Get axis positions on a 3D plot }
\description{
Calculate the axis positions on a 3D plot.
}
\usage{
get_axispos3d(edge,pmat,at,pos=NULL, dist=0)
}
\arguments{
\item{edge}{ which axis to calculate.}
\item{pmat}{ matrix to transform coordinates. }
\item{at}{ position on the axis. }
\item{pos}{ position of the axis relative to the other axes. }
\item{dist}{ Offset of the axis. }
}
\value{A position in 2D coordinates}
\author{Ben Bolker}
\keyword{misc}
plotrix/man/arctext.Rd 0000755 0001762 0000144 00000004564 14011145766 014510 0 ustar ligges users \name{arctext}
\title{Display text on a circular arc}
\description{Displays a character string on the circumference of an imaginary
circle on an existing plot.}
\usage{
arctext(x,center=c(0,0),radius=1,start=NULL,middle=pi/2,end=NULL,stretch=1,
clockwise=TRUE,cex=NULL,...)
}
\alias{arctext}
\arguments{
\item{x}{A character string.}
\item{center}{The center of the circular arc in x/y user units.}
\item{radius}{The radius of the arc in user units.}
\item{start}{The starting position of the string in radians.}
\item{middle}{The middle position of the string in radians.}
\item{end}{The end position of the string in radians.}
\item{stretch}{How much to stretch the string for appearance.}
\item{clockwise}{Whether to print the string in the clockwise direction.}
\item{cex}{The character expansion factor.}
\item{...}{additional arguments passed to \samp{text}.}
}
\details{
\samp{arctext} displays a string along a circular arc, rotating each
letter. This may not work on all devices, as not all graphic devices
can rotate text to arbitrary angles. The output looks best on a
Postscript or similar device that can rotate text without distortion.
Rotated text often looks very ragged on small bitmaps.
If the user passes a value for
\samp{start}, this will override any value passed to \samp{middle}.
If the plot area is not square, see \samp{par(pty="s")}, the arc will
be somewhat elliptical.
If the \samp{clockwise} argument is TRUE, the string will be displayed
in a clockwise direction and the orientation of the characters will be
rotated \samp{pi} radians (180 degrees). This is useful when the string
is to be displayed on the bottom of the circumference.
}
\value{nil}
\author{Jim Lemon - Thanks to Suhas Parandekar for the idea, Ted Toal
for greatly improving the placement of the text and Andy South for
providing the initial code for the clockwise argument.}
\seealso{\link{text}}
\examples{
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)
}
\keyword{misc}
plotrix/man/do.first.Rd 0000644 0001762 0000144 00000001246 14011145766 014555 0 ustar ligges users \name{do.first}
\alias{do.first}
\title{ Execute a graphic function on a plot }
\description{ do.first allows the user to execute one or more commands before
displaying values on a plot. }
\details{
\samp{do.first} is an argument in some plotrix functions that allows the user
to do things like add a background color or a grid to the plot before
displaying the other plot elements.
The value of \samp{do.first} should be a character string that can be parsed
to one or more valid R commands. Remember to enclose the string in quotes,
separate commands with semicolons and escape quotes within the string with
backslashes if necessary.
}
\keyword{misc}
plotrix/man/oz.windrose.legend.Rd 0000755 0001762 0000144 00000001776 14011145766 016556 0 ustar ligges users \name{oz.windrose.legend}
\alias{oz.windrose.legend}
\title{Display an Australian wind rose legend}
\description{
Displays a wind rose legend in the style used by the Australian Bureau
of Meteorology.
}
\usage{
oz.windrose.legend(maxpct=20,scale.factor=30,
speed.col=c("#dab286","#fe9a66","#ce6733","#986434"),
speed.width=NA,legend.pos=NA)
}
\arguments{
\item{maxpct}{The maximum percentage to display on the radial grid.}
\item{scale.factor}{The scale factor for the plot.}
\item{speed.col}{Colors representing speed ranges.}
\item{speed.width}{Half widths of the bars representing speed ranges.}
\item{legend.pos}{The vertical position of the wind rose legend. The
Australian Bureau of Meteorology displays the legend at the top of
the plot}
}
\value{nil}
\author{Jim Lemon (thanks to Anna in the Sydney BoM office)}
\seealso{\link{oz.windrose}}
\examples{
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)
}
\keyword{misc}
plotrix/man/radial.plot.labels.Rd 0000755 0001762 0000144 00000004514 14011145766 016503 0 ustar ligges users \name{radial.plot.labels}
\title{Display labels on a circular grid}
\usage{
radial.plot.labels(lengths,radial.pos=NULL,units="radians",radial.lim=NULL,
start=0,clockwise=FALSE,labels,adj=NULL,pos=NULL,boxed.labels=FALSE,...)
}
\alias{radial.plot.labels}
\arguments{
\item{lengths}{numeric data vector. Magnitudes will be represented as
the radial positions of symbols, line ends or polygon vertices.}
\item{radial.pos}{numeric vector of radial positions. These will be
converted to radians if the \samp{units} argument is not "radians".}
\item{units}{The units of \samp{radial.pos} may be degrees or 24 hour clock
positions. If \samp{units} is "polar" or "clock24" respectively, the
values of radial.pos will be converted into radians.}
\item{radial.lim}{Optional radial limits for the circular plot. These
must be the same as the radial limits of the original plot.}
\item{start}{The zero position on the plot in the units of \samp{radial.pos}.}
\item{clockwise}{Whether to increase angles clockwise rather than the
default counterclockwise.}
\item{labels}{text labels to display on the plot.}
\item{adj}{Text justification as in the \samp{text} function.}
\item{pos}{Text position as in the \samp{text} function.}
\item{boxed.labels}{Whether to use \samp{boxed.labels} or \samp{text}.}
\item{...}{additional arguments passed to \samp{boxed.labels} or
\samp{text}.}
}
\description{
\samp{radial.plot.labels} displays a labels on a circular plot produced by
one of the radial.plot family of functions.
}
\details{
Don't confuse this function with the \samp{radial.labels} argument in
the radial.plot function. This labels the values rather than the grid.
}
\value{nil}
\author{Jim Lemon}
\keyword{misc}
\seealso{\link{text}}
\examples{
testlen<-c(rnorm(10)*2+5)
# do the labels in clock24 units
testpos<-c(6.74,8.3,10.55,12.33,13.75,15.9,17.15,19.36,21.02,23.27)
oldpar<-clock24.plot(testlen,testpos,main="Test radial.plot.labels",
rp.type="s",point.symbols=3,point.col="green")
radial.plot.labels(testlen,testpos,units="clock24",labels=LETTERS[1:10],
pos=3,col="red")
testangle<-c(25,42,67,94,128,173,191,234,268,307)
# now a polar plot
polar.plot(testlen,testangle,main="Test radial.plot.labels",rp.type="p",
poly.col="green")
radial.plot.labels(testlen,testangle,units="polar",labels=LETTERS[1:10])
# reset par
par(oldpar)
}
plotrix/man/makeDensityMatrix.Rd 0000644 0001762 0000144 00000006200 14011145766 016462 0 ustar ligges users \name{makeDensityMatrix}
\alias{makeDensityMatrix}
\title{Compute a matrix of counts from a list of x,y positions}
\description{
Compute a matrix in which the counts in each cell represent the number of
occurrences of that cell's coordinates in a list of x,y cooordinate values,
optionally computing a second matrix of the average of the values attached
to the coordinate observations.
}
\usage{
makeDensityMatrix(x,y,z=NULL,nx=100,ny=50,zfun=c("mean","sum"),
xlim=c(-180,180),ylim=c(-90,90),geocoord=TRUE)
}
\arguments{
\item{x,y}{Vectors of x and y coordinates. These are usually combined in a
matrix or data frame of two columns.}
\item{z}{Optional values attached to each coordinate pair. If these are present,
it can be in a matrix or data frame of three columns, x, y and z.}
\item{nx}{The number of "x" cells in the output matrix.}
\item{ny}{The number of "y" cells in the output matrix.}
\item{zfun}{The function to apply to the summed values attached to each
coordinate pair. Currently defaults to mean, otherwise the sum is returned.}
\item{xlim}{The extreme coordinates in the horizontal direction (see Details).}
\item{ylim}{The extreme coordinates in the vertical direction (see Details).}
\item{geocoord}{Whether to correct the matrix values for the areal distortion
of the Mercator projection.}
}
\details{
\samp{makeDensityMatrix} expects two vectors or a matrix or data frame with
at least two columns. The function was written for geographic coordinates,
but will also work for other numeric coordinates. An optional third vector
or column of values for each coordinate will be processed.
Each coordinate pair adds to the count in that cell of the matrix. If there
is a third element, that value is added to a second matrix in the same
position. By default, the function computes the mean of all values in each
cell. If \samp{zfun="sum"}, the sum of values in each cell will be returned.
As geograhic data sets may be very large, leading to memory problems,
\samp{makeDensityMatrix} can be run on small sections of the data set and the
resulting matrices added together as long as the coordinate limits are
consistent throughout.
}
\value{
Either a matrix of counts of coordinate pairs within each cell or a list of
two such matrices, the second containing the mean or sum of values associated
with coordinate pairs.
}
\examples{
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)
}
\author{Jim Lemon}
\seealso{\link{densityGrid}}
\keyword{misc}
plotrix/man/triax.frame.Rd 0000755 0001762 0000144 00000003051 14011145766 015244 0 ustar ligges users \name{triax.frame}
\alias{triax.frame}
\title{Triangle plot frame}
\description{
Display a three axis frame with optional grid.
}
\usage{
triax.frame(at=seq(0.1,0.9,by=0.1),axis.labels=NULL,
tick.labels=NULL,col.axis="black",cex.axis=1,cex.ticks=1,
align.labels=TRUE,show.grid=FALSE,col.grid="gray",lty.grid=par("lty"),
cc.axes=FALSE)
}
\arguments{
\item{at}{The tick positions on the three axes.}
\item{axis.labels}{Labels for the three axes in the order bottom, right
left. Defaults to the column names.}
\item{tick.labels}{The tick labels for the axes.
Defaults to argument \samp{at} (proportions).}
\item{col.axis}{Color of the triangular axes, ticks and labels.}
\item{cex.axis}{Character expansion for axis labels.}
\item{cex.ticks}{Character expansion for the tick labels.}
\item{align.labels}{Logical - whether to align axis and tick labels with
the axes.}
\item{show.grid}{Whether to display grid lines at the ticks.}
\item{col.grid}{Color of the grid lines. Defaults to gray.}
\item{lty.grid}{Type of line for the grid.}
\item{cc.axes}{Whether to align the axes clockwise or counterclockwise.}
}
\details{
\samp{triax.frame} displays a triangular plot area on which proportions
or percentages may be displayed. An optional grid may also be displayed.
If \samp{cc.axes} is TRUE, both the axes and axis ticks will be in
reverse order.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{triax.points},\link{triax.abline},\link{triax.fill}}
\examples{
triax.plot(main="DEFAULT")
triax.plot(main="Clockwise axes",cc.axes=TRUE)
}
\keyword{misc}
plotrix/man/barp.Rd 0000755 0001762 0000144 00000020737 14011145766 013762 0 ustar ligges users \name{barp}
\alias{barp}
\title{A bar plotting routine}
\description{Display a bar plot}
\usage{
barp(height,width=0.4,names.arg=NULL,legend.lab=NULL,legend.pos=NULL,
col=NULL,border=par("fg"),main=NULL,xlab="",ylab="",xlim=NULL,ylim=NULL,
x=NULL,staxx=FALSE,staxy=FALSE, height.at=NULL,height.lab=NULL,
cex.axis=par("cex.axis"),pch=NULL,cylindrical=FALSE,shadow=FALSE,
do.first=NULL,ylog=FALSE,srt=NULL,...)
}
\arguments{
\item{height}{A numeric vector, matrix or data frame that will be represented
as the heights of bars.}
\item{width}{Half the width of a single bar or group of bars in X axis units.}
\item{names.arg}{The labels for the bars or groups of bars.}
\item{legend.lab}{Labels for an optional legend. If NULL, no legend is
displayed.}
\item{legend.pos}{Optional position for the legend as a list with \samp{x}
and \samp{y} components. If this is NULL, \samp{locator} will be called.}
\item{col}{The fill colors for the bars. The default is no fill.}
\item{border}{The border for the bars.}
\item{main}{The title at the top of the plot.}
\item{xlab,ylab}{The labels for the X and Y axes respectively.}
\item{xlim,ylim}{Optional horizontal and vertical limits for the plot.}
\item{x}{Optional horizontal positions for the bars. Defaults to 1:length(height).}
\item{staxx,staxy}{Whether to use \link{staxlab} to stagger the
X or Y axis tick labels. Can also omit the X or Y axes.}
\item{height.at}{Optional positions of the tick marks on the Y axis.}
\item{height.lab}{Optional tick labels for the Y axis.}
\item{cex.axis}{Character expansion for the axis labels.}
\item{pch}{Symbol(s) to fill the bars. See Details.}
\item{cylindrical}{Whether to give the bars a cylindrical appearance
by shading them.}
\item{shadow}{Whether to place a shadow behind the bars.}
\item{do.first}{An optional string that will be evaluated before anything
else is displayed on the plot. Useful for background colors or lines.}
\item{ylog}{Logical for whether a log scale is to be used. see details.}
\item{srt}{Rotation of axis labels if staxx or staxy is TRUE (see
\samp{staxlab}).}
\item{...}{arguments passed to \samp{plot}}.
}
\value{
A list containing two components of the same form as \samp{height}:
\item{x}{The centers of the bars displayed.}
\item{y}{The heights of the bars.}
}
\details{
\samp{barp} displays a bar plot similar to \samp{barplot} but with axes and
horizontal bar positions more like \samp{plot}. Bars or groups of bars are
centered on integral X values by default, and so both the width and spacing of
the bars are controlled by a single number. If the user passes explicit \samp{x}
values, those values will determine the spacing. If \samp{height} is a vector,
single bars representing each value will be displayed centered at
\samp{1:length(height)} unless the user has specified \samp{x} values.
If \samp{height} is a matrix, 2D array, or data frame, a group of bars will be
drawn for each column, with the values of the group taken from the rows of that
column. Explicit x values cannot be used with a matrix, however, by adjusting the
values of x, grouped bars can be displayed.
The values from \samp{freq} or \samp{brkdn} in the prettyR package can
be used as the \samp{height} argument. The value from \samp{table} can also be
passed as \samp{height}, as can a 2D array returned from the \samp{by} function.
Bars are empty by default but fill colors can be defined in several ways.
If a single color is passed, all bars will be the same color. If \samp{height}
is a vector, colors will be recycled or some will be ignored if the length of
\samp{col} is
not equal to that of \samp{height}. If \samp{height} is a matrix or data frame,
the user may pass a vector of colors equal to the number of rows in \samp{height}
or a matrix of colors of the same dimensions as \samp{height}. Other sequences
of color will probably not result in an easy to interpret plot.
\samp{barp} is intended to simplify illustrating categorical data for which both
the variable designations and the categories are names, as on many multiple
choice questions. \samp{height.at} and \samp{height.lab} allow the user to place
labels on the vertical axis, usually representing the options. If \samp{staxx}
or \samp{staxy} are TRUE, the labels on the horizontal or vertical axes
respectively will be staggered, allowing the user to use many or lengthy variable
or value labels. If \samp{srt} is not NULL, these labels will be rotated
counterclockwise by that value as angles in degrees instead of staggered.
If \samp{staxx} or \samp{staxy} are set to NA, the respective axis will not
be displayed.
\samp{barp} allows two enhancements that may be useful in those areas where fancy
plots are appreciated. One is to give the bars a cylindrical look by shading the
color. The other is to place an apparent shadow behind each bar. Both of these
effects appear as though the light is coming from the upper left, and this is
hard coded. You can add error bars by calling \samp{dispersion}, but many advise
against this.
If \samp{legend.lab} is not NULL, a legend will be displayed. If
\samp{legend.pos} is NULL, \samp{locator} is called to place the legend. On
Windows, the alert may not appear on the console, and the function will
appear to hang unless the user clicks on the console window or the plot.
The \samp{ylog} argument produces a log scale on the y axis. Currently,
neither \samp{pretty} nor \samp{axTicks} seems to produce a nice set of axis
ticks, so it is best to pass the positions of these in \samp{height.at}.
If the \samp{pch} argument is not NULL, barp will display white bars filled
with the symbols specified in \samp{pch}. With grouped bars, this must be a
matrix with the same form as the \samp{col} argument. This option allows a
black and white bar plot to be produced.
}
\author{Jim Lemon}
\seealso{\link{staxlab}, \link{barplot}, \link{cylindrect},
\link{gradient.rect}}
\examples{
# get some extra room on the left
par(mar=c(5,5,4,2))
# make up some happiness data, as so many seem to do
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="9AM happiness by weekday",
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)
# now do a plot with colors scaled to the sex ratio (real data!)
sexratio<-c(0.24,0.35,0.09,0.59,0.63,0.34,0.7,0.6)
# the fun ratings are once again a pack of lies
funrating<-c(3.2,3.5,1.5,5.4,4.5,2.7,6.8,4.9)
funstudy<-c("Astronomy","Chemistry","Economics","Anthropology","Linguistics",
"Math/Stats","Psychology","Sociology")
funlabels<-c("Torture","Agony","Boredom","Neutral","Entertaining","Exhilarating",
"Maniacal")
# xrange is used to get the colors to match the 0-100% scale
barp(funrating,names.arg=funstudy,main="Fun ratings for various areas of study",
col=color.scale(sexratio,c(0.2,1),c(0.2,0.4),c(1,0.4),xrange=c(0,1)),
xlab="Study",ylab="Rating",height.at=1:7,height.lab=funlabels,ylim=c(1,7),
staxx=TRUE,staxy=TRUE,cex.axis=0.9)
# here we want the full scale from zero to one
color.legend(2,6,4,6.4,legend=c("100\% guys","100\% girls"),
rect.col=color.scale(seq(0,1,by=0.25),c(0.2,1),c(0.2,0.4),c(1,0.4)))
par(mar=c(5,4,4,2))
# use barp to display a multiple histogram with a shaded background
# notice how the expression uses local variables inside the barp function
gradbg<-"gradient.rect(xlim[1],ylim[1],xlim[2],ylim[2],
c(1,0.5,1),c(1,0.5,1),c(1,0.5,1),gradient=\"y\",nslices=100)"
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,do.first=gradbg,
main="Multiple histogram using barp",xlab="Bins",ylab="Frequency")
legend(3.8,50,c("h1","h2","h3"),fill=2:4)
# now display a positive/negative plot
barp(c(2,-3,4,-5,6,-7,8),main="Positive/negative plot",
xlab="Alternating colors",ylab="For alternating values",
col=2+(c(2,-3,4,-5,6,-7,8)>0))
}
\keyword{misc}
plotrix/man/plotrix-package.Rd 0000644 0001762 0000144 00000004657 14116103071 016115 0 ustar ligges users \name{plotrix-package}
\alias{plotrix-package}
\alias{plotrix}
\docType{package}
\title{
Specialized plots and plotting accessories
}
\description{
A large number of specialized plots and accessory functions like color
scaling, text placement and legends.
}
\details{
\tabular{ll}{
Package: \tab plotrix\cr
Version: \tab 3.8-1\cr
Date: \tab 2021-09-08\cr
License: \tab GPL (>=2)\cr
Packaged: \tab 2021-09-08 03:45:00 UTC; root\cr
Built: \tab R 4.0.3; ; 2021-09-08 03:45:00 UTC; linux\cr
}
The plotrix package is intended to provide a method for getting many sorts of
specialized plots quickly, yet allow easy customization of those plots
without learning a great deal of specialized syntax. There are three major
aims that can be represented as follows:
Fast foods
Think of plotrix as a graphics vending machine or fast graphics cafe. You walk
in, make your choice and get your lunch. It may not be exactly the lunch you
want, but you do get a pretty good lunch, fast. You can get junk food or
health food, you make the choice.
Hot rods
You can customize plotrix as much as you want. Like the ageing machinery that
is usually bolted into hot rods, the base graphics package is fairly easy to
understand. plotrix is modular. You can create a frame for your plot, then
you can add whatever bits you like to it instead of just taking the default
plot that is available. You can have wide wheels and chromed exhaust pipes if
you want.
No black boxes
If you want to go from pushing the fast food button to hot rodding, it's not
hard. The source code in the functions is written to be understood. If
something goes wrong, you can usually find where it happened right away and
work on it. This means that you can learn about how the functions do what
they do rather than just what they do. So that's how to write recursive
functions in R!
Because plotrix encourages users to learn how it works, you usually begin to
do so pretty quickly. Users often decide to write their own versions of
plotrix functions and sometimes they contribute the results back into plotrix.
You may find that you like other graphics systems like grid or lattice better.
That's great, because one idea behind plotrix is that if you get into R and
can get things done quickly and easily, you'll stick with it and soon want to
get things done your way.
}
\author{
Jim Lemon , and many others
Maintainer: Jim Lemon
}
\keyword{ package }
plotrix/man/get.tablepos.Rd 0000644 0001762 0000144 00000001475 14011145766 015420 0 ustar ligges users \name{get.tablepos}
\alias{get.tablepos}
\title{Get the position for a legend or table}
\description{
Gets the x and y positions and justification for a legend or table in
user units from the string descriptors like "top".
}
\usage{
get.tablepos(x)
}
\arguments{
\item{x}{A valid position descriptor like "top".}
}
\details{
\samp{get.tablepos} checks for one of the nine valid position descriptors:
topleft, top, topright, left, center, right, bottomleft, bottom and bottomright.
If none of these descriptors are found, it will return the center position
and justification.
}
\value{
A list containing:
\item{x}{x position}
\item{y}{y position}
\item{xjust}{x (horizontal) justification}
\item{yjust}{y (vertical) justification}
}
\author{Jim Lemon}
\seealso{\link{addtable2plot}, \link{legendg}}
\keyword{misc}
plotrix/man/draw.circle.Rd 0000755 0001762 0000144 00000002705 14011145766 015226 0 ustar ligges users \name{draw.circle}
\alias{draw.circle}
\title{Draw a circle}
\description{Draws a circle on an existing plot.}
\usage{
draw.circle(x,y,radius,nv=100,border=NULL,col=NA,lty=1,density=NULL,
angle=45,lwd=1)
}
\arguments{
\item{x,y}{Coordinates of the center of the circle.}
\item{radius}{Radius (or radii) of the circle(s) in user units.}
\item{nv}{Number of vertices to draw the circle.}
\item{border}{Color to use for drawing the circumference.}
\item{col}{Color to use for filling the circle.}
\item{lty}{Line type for the circumference.}
\item{density}{Density for patterned fill. See \samp{polygon}.}
\item{angle}{Angle of patterned fill. See \samp{polygon}.}
\item{lwd}{Line width for the circumference.}
}
\value{
A list with the x and y coordinates of the points on the circumference
of the last circle displayed.
}
\details{
\samp{draw.circle} uses the dimensions of the plot and the \samp{x} and
\samp{y} coordinates to draw a circle rather than an ellipse.
}
\author{Jim Lemon, thanks to David Winsemius for the density and angle args}
\seealso{\link{polygon}}
\examples{
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",col="yellow",lty=1,
density=5,angle=30,lwd=10)
draw.circle(3.5,8,0.8,border="blue",lty=2,lwd=2)
}
\keyword{misc}
plotrix/man/color.gradient.Rd 0000755 0001762 0000144 00000002113 14011145766 015734 0 ustar ligges users \name{color.gradient}
\title{Calculate an arbitrary sequence of colors}
\usage{
color.gradient(reds,greens,blues,nslices=50)
}
\alias{color.gradient}
\arguments{
\item{reds,greens,blues}{vectors of the values of the color components
as 0 to 1.}
\item{nslices}{The number of color "slices".}
}
\description{
\samp{color.gradient} is now just a call to \samp{color.scale} with a
vector of equally spaced integers (1:nslices). The function is kept for
backward compatibility.
}
\note{
The function is mainly useful for defining a set of colors to represent
a known number of gradations. Such a set can be used to assign a grade
to a small number of values (e.g. points on a scatterplot - but see
\samp{color.scale} for large numbers) and display a color bar using
\samp{gradient.rect} as a legend.
}
\value{A vector of hexadecimal color values as used by \samp{col}.}
\author{Jim Lemon}
\seealso{\link{rescale},\link{approx},\link{color.scale}}
\examples{
# try it with red and blue endpoints and green midpoints.
color.gradient(c(0,1),c(1,0.6,0.4,0.3,0),c(0.1,0.6))
}
\keyword{misc}
plotrix/man/draw.ellipse.Rd 0000755 0001762 0000144 00000003742 14011145766 015424 0 ustar ligges users \name{draw.ellipse}
\alias{draw.ellipse}
\title{Draw ellipse}
\description{Draws ellipses on an existing plot.}
\usage{
draw.ellipse(x, y, a = 1, b = 1, angle = 0, segment = NULL,
arc.only = TRUE, deg = TRUE, nv = 100, border = NULL,
col = NA, lty = 1, lwd = 1, ...)
}
\arguments{
\item{x}{
A vector or a matrix (if \code{y} is missing).}
\item{y}{
A vector, can be missing.
}
\item{a,b}{
Vectors, radii of the ellypses along the two axes in user units.
}
\item{angle}{
Angle of rotation in degrees (if \code{deg=TRUE}) or in radians
(if \code{deg=FALSE}).
}
\item{segment}{
Start and endpoints of arc in degrees (if \code{deg=TRUE}) or in radians
(if \code{deg=FALSE}).
}
\item{arc.only}{
Logical, if \code{segmen} the full ellipse is not drawn, radii from the
ends of the arc are drawn to form a sector (see Examples).
}
\item{deg}{
Logical, if angles are given in degrees (\code{TRUE}) or radians.
}
\item{nv}{
Number of vertices to draw the ellipses.
}
\item{border}{
Color to use for drawing the circumference.
}
\item{col}{
Color to use for filling the circle.
}
\item{lty}{
Line type for the circumference.
}
\item{lwd}{
Line width for the circumference.
}
\item{\dots}{
Additional arguments passed to \code{\link{polygon}}.
}
}
\value{Draw ellipses as a side effect.}
\author{Peter Solymos }
\seealso{\link{polygon}}
\examples{
plot(c(0,10), c(0,10), type="n", main="test draw.ellipse")
draw.ellipse(c(3,7), c(8,8), c(0.5,1), c(1,0.5), col=c(2,4),
angle=c(45,0), segment=rbind(c(0,45),c(45,360)))
draw.ellipse(c(3,7), c(6,6), c(0.5,1), c(1,0.5), col=c(2,4),
angle=c(45,0), segment=rbind(c(0,45),c(45,360)), arc.only=FALSE)
draw.ellipse(c(3,7), c(4,4), c(0.5,1), c(1,0.5), border=c(2,4),
angle=c(45,0), segment=rbind(c(0,45),c(45,360)), arc.only=FALSE)
draw.ellipse(c(3,7), c(2,2), c(0.5,1), c(1,0.5), border=1,
angle=c(45,0), lty=3)
draw.ellipse(c(3,7), c(2,2), c(0.5,1), c(1,0.5), border=c(5,3),
angle=c(45,0), nv=c(3,4), lty=2, lwd=2)
}
\keyword{misc}
plotrix/man/triax.points.Rd 0000755 0001762 0000144 00000003604 14011145766 015472 0 ustar ligges users \name{triax.points}
\alias{triax.points}
\title{Triangle plot points}
\description{
Display points on a triangle plot.
}
\usage{
triax.points(x,show.legend=FALSE,label.points=FALSE,
point.labels=NULL,col.symbols=par("fg"),pch=par("pch"),
bg.symbols=par("bg"),cc.axes=FALSE,...)
}
\arguments{
\item{x}{Matrix or data frame where each row is three proportions or
percentages that must sum to 1 or 100 respectively.}
\item{show.legend}{Logical - whether to display a legend.}
\item{label.points}{Logical - whether to call \samp{thigmophobe.labels}
to label the points.}
\item{point.labels}{Optional labels for the points and/or legend.}
\item{col.symbols}{Color of the symbols representing each value.}
\item{pch}{Symbols to use in plotting values.}
\item{bg.symbols}{Background color for plotting symbols.}
\item{cc.axes}{Clockwise or counterclockwise axes and ticks.}
\item{...}{Additional arguments passed to \samp{points}.}
}
\details{
In order for \samp{triax.points} to add points to an existing plot,
the argument \samp{no.add} in the initial call to \samp{triax.plot}
must be set to \samp{FALSE}. Failing to do this will result in the
points being plotted in the wrong places. It is then up to the user
to call \samp{par} as in the example below to restore plotting
parameters altered during the triangle plot.
\samp{triax.points} displays each triplet of proportions or percentages
as a symbol on the triangle plot. Unless each triplet sums to 1
(or 100), they will not plot properly and \samp{triax.points} will
complain appropriately.
}
\value{A list of the \samp{x,y} positions plotted.}
\author{Jim Lemon}
\seealso{\link{triax.plot},\link{thigmophobe.labels}}
\examples{
data(soils)
triax.return<-triax.plot(soils[1:10,],
main="Adding points to a triangle plot",no.add=FALSE)
triax.points(soils[11:20,],col.symbols="green",pch=3)
par(triax.return$oldpar)
}
\keyword{misc}
plotrix/man/triax.abline.Rd 0000755 0001762 0000144 00000002524 14011145766 015410 0 ustar ligges users \name{triax.abline}
\alias{triax.abline}
\title{Lines for triangle plot}
\description{
Display lines on a triangle plot.
}
\usage{
triax.abline(b=NULL,r=NULL,l=NULL,col=par("col"),lty=par("lty"),
cc.axes=FALSE)
}
\arguments{
\item{b}{Lines relating to the bottom axis.}
\item{r}{Lines relating to the right axis.}
\item{l}{Lines relating to the left axis.}
\item{col}{Color(s) of the lines.}
\item{lty}{Type(s) of the lines.}
\item{cc.axes}{Clockwise/counterclockwise axes and ticks.}
}
\details{
\samp{triax.abline} displays one or more lines on a triangle plot. Lines
are oriented in the conventional way, horizontal for the left axis,
slanting up to the right for the right axis and up to the left for the
bottom axis. If \samp{cc.axes} is TRUE, the orientation is up-left for
the left axis, horizontal for the right axis and up-right for the bottom
axis.
Remember to call \samp{triax.plot} with \samp{no.add=FALSE} and restore
the graphics parameters as in the example or the lines will not be
placed properly.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{triax.plot}}
\examples{
triax.return<-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(triax.return$oldpar)
}
\keyword{misc}
plotrix/man/fill.corner.Rd 0000644 0001762 0000144 00000001455 14011145766 015244 0 ustar ligges users \name{fill.corner}
\alias{fill.corner}
\title{
Fill a "corner" of a matrix with values
}
\description{
Fills one corner of a matrix with the supplied values, leaving the rest
filled with a default value.
}
\usage{
fill.corner(x,nrow,ncol,na.value=NA)
}
\arguments{
\item{x}{A vector of values.}
\item{nrow,ncol}{The number of rows and columns in the matrix to be returned.}
\item{na.value}{The default value for unfilled cells.}
}
\details{
\samp{fill.corner} creates an nrow by ncol matrix and fills the lower left
corner with the values supplied in \samp{x}. If there are more values in
\samp{x} than cells in the matrix, only the first nrow*ncol values will be
inserted.
}
\value{An nrow by ncol matrix containing the values in \samp{x}.}
\author{Jim Lemon}
\keyword{misc}
plotrix/man/plotH.Rd 0000644 0001762 0000144 00000005126 14011145766 014114 0 ustar ligges users \name{plotH}
\alias{plotH}
\alias{plotH.formula}
\alias{plotH.default}
\title{Scatterplot with histogram-like bars.}
\description{
Scatterplot with histogram-like bars; a modification of
\samp{plot(...,type="h")}.
}
\usage{
plotH(x,...)
\method{plotH}{formula}(x,data=NULL,xlab=names(mf)[2],ylab=names(mf)[1],...)
\method{plotH}{default}(x,y,xlab=paste(deparse(substitute(x))),
ylab=paste(deparse(substitute(y))),width=0.6,ylim=NULL,col="gray",...)
}
\arguments{
\item{x}{Vector of x-coordinates or a formula of the form y~x
(see below for y).}
\item{y}{Vector of y-coordinates.}
\item{xlab}{A string for labeling the x-axis.}
\item{ylab}{A string for labeling the y-axis.}
\item{data}{The data frame from which the formula should be evaluated.}
\item{width}{A numeric that indicates the width of the bars.}
\item{ylim}{A vector of length two that indicates the limits over which to
plot the y-axis. See details.}
\item{col}{A string that indicates the fill color for the bars.}
\item{...}{Additional arguments sent to the \samp{plot} or \samp{barplot}
functions.}
}
\details{
\samp{plotH} is meant to be a modification of the type="h" version of
\samp{plot} such that the "bars" appears as actual rectangles rather than
vertical lines. It defaults so that the lower bound of the y-axis is 0;
change to \samp{ylim=NULL} to over-ride this default (and return to the
default used in \samp{plot}.
A pass-through to \samp{barplot} is used if the \samp{x} (or "RHS") variable
is categorical.
}
\value{None, but a plot is produced.}
\note{This function is currently experimental.}
\author{Derek Ogle}
\seealso{\link{plot}, \link{barplot}}
\examples{
d<-data.frame(x=c(1,5,10:20),y=runif(13)+1,
yn1=runif(13)-0.5,yn2=runif(13)-2,
g=factor(sample(c("A","B","C"),13,replace=TRUE)))
# new plotH function with formula notation
plotH(y~x,data=d)
# old plot() function with formula notation -- for comparison's purpose
plot(y~x,data=d,type="h")
# new function over-riding default ylim, increasing bar width,
# and changing bar color
plotH(y~x,data=d,ylim=range(d$y),width=0.9,col="red")
# handling some negative values
plotH(yn1~x,data=d) # not so good, because of default ylim
plotH(yn1~x,data=d,ylim=c(0,max(d$yn1))) # old look
# handling all negative values
plotH(yn2~x,data=d)
plotH(yn2~x,data=d,ylim=range(d$yn2)) # old look
# example of pass-through to barplot
smry<-by(d$y,d$g,mean)
plotH(levels(d$g),smry,ylab="Mean of Random Variable",xlab="Group")
# example of non-formula usage
x1 <- d$x
y1 <- d$y
plotH(x1,y1,col="blue")
}
\keyword{misc}
plotrix/man/tsxpos.Rd 0000644 0001762 0000144 00000003057 14011145766 014367 0 ustar ligges users \name{tsxpos}
\title{Calculate equispaced x positions.}
\description{Calculate equispaced x positions of values that have been
plotted with the plot command.}
\usage{
tsxpos(x,xlim,nint)
}
\alias{tsxpos}
\arguments{
\item{x}{A vector of numeric values or a time series object created with
the ts function.}
\item{xlim}{Explicit x limits for the x positions.}
\item{nint}{The number of \emph{intervals} between x positions.}
}
\details{
\samp{tsxpos} calculates equispaced x positions for a vector of values or
a time series created with the \samp{ts} command from the \pkg{stats} package.
It assumes that the default x limits have been used in the existing plot. It
adds the appropriate padding if \samp{par("xaxs")} is "r". It is mainly useful
when x axis labels or some other markers are to be added to a time series plot.
A plot device must be open. If the user wishes to specify explicit x limits
or the number of intervals (not values), these will override the calculations
from the x values.
}
\value{The calculated x positions in user units.}
\author{Jim Lemon (thanks to Prof J.C. Nash for the idea)}
\examples{
# create a vector of numbers
y<-rnorm(28)
par(mfrow=c(2,1),mar=c(6,4,4,2))
plot(y,main="Plot of the values")
# convert it into a time series object
yt<-ts(y,start=2011,frequency=12)
# don't use the default axis
plot(yt,main="Plot of the time series",xaxt="n",xlab="Month")
labelpos<-tsxpos(yt)
# display an axis showing the months only
staxlab(1,labelpos,rep(month.abb,length.out=28))
par(mfrow=c(1,1),mar=c(5,4,4,2))
}
\keyword{misc}
plotrix/man/raw.means.plot.Rd 0000644 0001762 0000144 00000033327 14011145766 015702 0 ustar ligges users \name{raw.means.plot}
\alias{raw.means.plot}
\alias{raw.means.plot2}
\title{
raw.means.plot: Raw-Means Plots for Experimental Designs
}
\description{
raw.means.plot is a function for visualizing results of experimental designs
with up to two factors. It plots both raw data (background) and factor/cell
means (foreground) to provide a more accurate visualization of the underlying
distribution.
}
\usage{
raw.means.plot(data, col.offset = 2, col.x = 3, col.value = 4, na.rm = FALSE,
avoid.overlap = c("y", "x", "both"), y.factor = 1, y.amount = NULL,
x.amount = 0.05, pch = 21:25, lty = 1:5, bg.b.col = "darkgrey",
bg.f.col = NULL, fg.b.col = "black",fg.f.col = "black", type = "o",
pt.cex = 1, lwd = 1, xlab = "", ylab = "", ylim, max.offset = 0.2,
xaxis = TRUE, x.labels, xaxt = "n", plot = TRUE, legend = TRUE, mar = NULL,
reset.mar = TRUE, l.pos, yjust = 0.5, l.bty = "n", l.adj = c(0, 0.5), ...)
raw.means.plot2(data, col.id, col.offset, col.x, col.value,
fun.aggregate = "mean", ...)
}
\arguments{
\item{data}{
a \samp{data.frame} in long format (i.e., each datapoint one row,
see \samp{\link{reshape}} or the reshape package) that contains at least
three columns: one column coding the first factor (\samp{col.offset}), one
column coding the second factor (\samp{col.x}), and one column containing
the values (\samp{col.value}).
}
\item{col.id}{
a \samp{character} scalar, specifiying the name of the column specifying the
id column. (only for \samp{raw.means.plot2})
}
\item{col.offset}{
a \samp{character} or \samp{numeric} (only \samp{raw.means.plot}) scalar,
specifiying either name or number of the column coding the different lines
(the offset or first factor).
}
\item{col.x}{
a \samp{character} or \samp{numeric} (only \samp{raw.means.plot}) scalar,
specifiying either name or number of the column coding the x-axis factor.
Default is 3.
}
\item{col.value}{
a \samp{character} or \samp{numeric} (only \samp{raw.means.plot}) scalar,
specifiying either name or number of the data column. Default is 4.
}
\item{na.rm}{
\samp{logical} indicating whether \samp{NA} values should be stripped before
the computation proceeds. Default is \samp{FALSE}. Throws an error message
if FALSE and NAs are encountered.
}
\item{avoid.overlap}{
character. What should happen to datapoints within one cell of the two
factors that have the same value.
\itemize{
\item \samp{"y"} (the default) \link{jitter} is added so that
overlapping points are distinguishable on the \strong{y}-axis
\item \samp{"x"} \link{jitter} is added so that overlapping points
are distinguishable on the \strong{x}-axis
\item \samp{"both"} \link{jitter} is added so that overlapping points
are distinguishable on both the \strong{y}- and the \strong{x}-axis.
\item anything else. No jitter is added.
}
}
\item{y.factor}{
\samp{factor} for controlling the amount of jitter on the y-axis
(will be passed to \link{jitter}).
}
\item{y.amount}{
\samp{amount} for controlling the amount of jitter on the y-axis
(will be passed to \link{jitter}).
}
\item{x.amount}{
\samp{amount} for controlling the amount of jitter on the x-axis
(will be passed to \link{jitter}).
}
\item{pch}{
\samp{pch} values (plot symbols) taken for plotting the data. Note that
the same values are taken for raw data and means. see \link{points}
for more details. Recycled if too short (with warning). Default is 21:25,
because those are the only values that can be displayed filled and non-filled.
All other values should not be used.
}
\item{lty}{
\samp{lty} values (line types) for connecting the means. See \link{par}
for more details. Recycled if too short (with warning). Default is 1:5.
}
\item{bg.b.col}{
background border color: border color of raw data points. Silently recycled. Default:
\samp{"darkgrey"}
}
\item{bg.f.col}{
background filling color: fill color of raw data points. Silently recycled. Default:
\samp{NULL}
}
\item{fg.b.col}{
foreground border color: border color of mean data points. Silently recycled. Default:
\samp{black}
}
\item{fg.f.col}{
foreground fill color: fill color for mean data points. Silently recycled. Default:
\samp{black}
}
\item{type}{
same as type in \link{plot}. Default: \samp{o} ("overplotted")
}
\item{pt.cex}{
\samp{numeric} specifying the \samp{cex} value used for plotting the points.
Default is 1.
}
\item{lwd}{
\samp{numeric} specifying the \samp{lwd} value used for plotting the lines.
Default is 1.
}
\item{xlab}{
x-axis label. Default: \samp{""}
}
\item{ylab}{
y-axis label. Default: \samp{""}
}
\item{ylim}{
the y-axis limits of the plot. If not specified (the default) will be taken
from data so that all raw data points are visible and a warning message is
displayed specifying the ylim.
}
\item{max.offset}{
\samp{numeric}. maximal offset of factor levels from the offset factor
(\samp{col.offset}) specifying the different lines. The centre of each factor
on the x-axis is at full numbers (starting from 1 to ...). The maximum will
only be reached if the number of factor levels (from \samp{col.offset}) is
even. Default: 0.2.
}
\item{xaxis}{
\samp{logical} value indicating whether or not the x-axis should be generated
by \samp{raw.means.plot}. If \samp{TRUE}, labels for the x-axis will be taken
either from the unique values of \samp{col.x} or can be specified with
\samp{x.labels}.
}
\item{x.labels}{
\samp{character} vector specifiying \samp{col.x} levels. Only relevant if
\samp{xaxis=TRUE}. Then, the values given here will be displayed at the
x-axis for each factor level of \samp{col.x}.
}
\item{xaxt}{
A character which specifies whether ot not the x-axis should be plotted by
the call to plot function. Interfers with the aforementioned \samp{xaxis}
argument and the automatic \samp{xaxis} function by \samp{raw.means.plot}.
Just there for completeness. Default \samp{"n"} (and should not be changed).
}
\item{plot}{
\samp{logical}. Should the \samp{raw.means.plot} be drawn or not. If
\samp{TRUE} (the default) plot will be drawn. If \samp{FALSE} only the legend
will be drawn (if \samp{legend = TRUE}) See details.
}
\item{legend}{
\samp{logical} indicating whether or not \samp{raw.means.plot} should
automatically add a legend on the right outside the plot area indicating
which line and points refer to which \samp{col.offset} factor levels. Default
is \samp{TRUE}.
}
\item{mar}{
\samp{NULL} or \samp{numerical} vector of length 4 indicating the margins of
the plot (see \link{par}). If \samp{NULL} (the default) the right
margin (i.e., \samp{par("mar")[4]}) will be (imperfectly) guessed from the
\samp{col.offset} factors for placing the legend right to the plot. If length
is four this value will be taken. Ignored for \samp{plot = FALSE}.
}
\item{reset.mar}{
\samp{logical} indicating if the margins (\samp{mar}) shall be resetted after
setting internally. Will be ignored if \samp{legend = FALSE}. Default is
\samp{TRUE} and should not be changed (especially with \samp{plot = FLASE}).
}
\item{l.pos}{
\samp{numeric} vector of length 2 indicating the position of the legend. If
not specified automatically determined. See details.
}
\item{yjust}{
how the legend is to be justified relative to the legend y location. A value
of 0 means top, 0.5 means centered and 1 means bottom justified. Default is
0.5.
}
\item{l.bty}{
the type of box to be drawn around the legend. The allowed values are
\samp{"o"} and \samp{"n"} (the default).
}
\item{l.adj}{
\samp{numeric} of length 1 or 2; the string adjustment for legend text. Useful
for y-adjustment when labels are plotmath expression. see \link{legend}
and \link{plotmath} for more info.
}
\item{\dots}{
further arguments which are either passed to plot or legend (or
\samp{raw.means.plot} for \samp{raw.means.plot2}). The following arguments
are passed to legend, all others are passed to plot:
\samp{"fill", "border", "angle", "density", "box.lwd", "box.lty", "box.col",
"pt.cex", "pt.lwd", "xjust", "x.intersp", "y.intersp", "text.width",
"text.col", "merge", "trace", "plot", "ncol", "horiz", "title", "inset",
"title.col", "title.adj"}
}
\item{fun.aggregate}{
Function or function name used for aggregating the data across the two
factors. Default is \samp{"mean"}. (only for \samp{raw.means.plot2})
}
}
\details{
\samp{raw.means.plot2} is probably the more useful function, as it allows for
using a data.frame with more than two-factors and aggregates across the other
factors, but needs a column specifying the experimental unit (e.g.,
participant).
\samp{raw.means.plot} is basically an advanced wrapper for two other
functions: \link{plot} and (if \samp{legend=TRUE})
\link{legend}. Furthermore, raw data is plotted with a call to
\link{points} and the means with a call to \link{lines}.
You can use \samp{raw.means.plot} to plot only a legend by setting
\samp{plot = FALSE} and \samp{legend = TRUE}. Then, \samp{raw.means.plot}
will draw an invisible plot with \samp{xlim = c(0,10)} and
\samp{ylim = c(0, 10)} and place the legend on this invisible plot. You
can specify \samp{l.pos} to position the legend, otherwise it will be plotted
at \samp{c(5,5)} (i.e., in the middle of the plot). Note that
\samp{xpd = TRUE} in the call to \samp{legend} (see \link{par}).
}
\value{
Nothing. This function is invoked for its side effects.
}
\author{
Henrik Singmann (\email{henrik.singmann@psychologie.uni-freiburg.de}) with
ideas from Jim Lemon
}
\seealso{
\link{add.ps} can be used in addition to\samp{raw.means.plot} to
compare the factors at each x-axis position, by adding p-values from t-tests
to the x-axis.
}
\examples{
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)
raw.means.plot(x, main = "Example", ylab = "Values", xlab = "Factor",
title = "Groups")
raw.means.plot(x, "offset", "xaxis", "data")
raw.means.plot(x, "xaxis", "offset", "data")
raw.means.plot(x, 3, 2, 4)
# different colors:
raw.means.plot(x, main = "Example", ylab = "Values", xlab = "Factor",
title = "Groups", fg.f.col = c("red","blue", "green"))
x2 <- 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)))
layout(matrix(c(1,2,3,3), 2,2,byrow = TRUE), heights = c(7,1))
raw.means.plot(x, main = "Data x1", ylab = "Values", xlab = "Factor",
legend = FALSE, mar = c(4,4,4,1)+0.1)
raw.means.plot(x2, main = "Data x2", ylab = "Values", xlab = "Factor",
legend = FALSE, mar = c(4,4,4,1)+0.1)
raw.means.plot(x2, plot = FALSE, title = "Groups")
y <- data.frame(id = 1:300, offset = rep(1, 300),
axis = sample(LETTERS[1:6],300, replace = TRUE), data = c(rnorm(100, 1),
rnorm(100), rnorm(100,1)))
par(mfrow = c(2,2))
raw.means.plot(y, legend = FALSE)
raw.means.plot(y, type = "p", legend = FALSE)
raw.means.plot(y, type = "l", legend = FALSE)
raw.means.plot(y, 3, 2, x.labels = "one group only")
# Example with overlapping points
z <- data.frame (id = 1:200, offset = rep(c("C 1", "C 2"), 200),
axis = sample(LETTERS[1:4], 200, replace = TRUE),
data = sample(1:20, 200, replace = TRUE))
# x versus y jitter
par(mfrow = c(2,2))
raw.means.plot(z, avoid.overlap = "none", main = "no-jitter")
raw.means.plot(z, main = "y-axis jitter (default)")
raw.means.plot(z, avoid.overlap = "x", main = "x-axis jitter")
raw.means.plot(z, avoid.overlap = "both", main = "both-axis jitter")
# y-axis jitter (default)
par(mfrow = c(2,2))
raw.means.plot(z, avoid.overlap = "none", main = "no jitter")
raw.means.plot(z, y.factor = 0.5, main = "smaller y-jitter")
raw.means.plot(z, main = "standard y-jitter")
raw.means.plot(z, y.factor = 2, main = "bigger y-jitter")
# x-axis jitter (default)
par(mfrow = c(2,2))
raw.means.plot(z, avoid.overlap = "none", main = "no jitter")
raw.means.plot(z, avoid.overlap = "x", x.amount = 0.025,
main = "smaller x -jitter")
raw.means.plot(z, avoid.overlap = "x", main = "standard x-jitter")
raw.means.plot(z, avoid.overlap = "x", x.amount= 0.1,
main = "bigger x-jitter")
\dontrun{
#The examples uses the OBrienKaiser dataset from car and needs reshape.
require(reshape)
require(car)
data(OBrienKaiser)
OBKnew <- cbind(factor(1:nrow(OBrienKaiser)), OBrienKaiser)
colnames(OBKnew)[1] <- "id"
OBK.long <- melt(OBKnew)
OBK.long[, c("measurement", "time")] <-
t(vapply(strsplit(as.character(OBK.long$variable), "\\\."), "[", c("", "")))
raw.means.plot2(OBK.long, "id", "measurement", "gender", "value")
raw.means.plot2(OBK.long, "id", "treatment", "gender", "value")
# also use add.ps:
# For this example the position at each x-axis are within-subject comparisons!
raw.means.plot2(OBK.long, "id", "measurement", "gender", "value")
add.ps(OBK.long, "id", "measurement", "gender", "value", paired = TRUE)
#reference is "fup"
raw.means.plot2(OBK.long, "id", "measurement", "gender", "value")
add.ps(OBK.long, "id", "measurement", "gender", "value", ref.offset = 2,
paired = TRUE) #reference is "post"
# Use R's standard (i.e., Welch test)
raw.means.plot2(OBK.long, "id", "treatment", "gender", "value")
add.ps(OBK.long, "id", "treatment", "gender", "value",
prefixes = c("p(control vs. A)", "p(control vs. B)"))
# Use standard t-test
raw.means.plot2(OBK.long, "id", "treatment", "gender", "value")
add.ps(OBK.long, "id", "treatment", "gender", "value", var.equal = TRUE,
prefixes = c("p(control vs. A)", "p(control vs. B)"))
}
}
plotrix/man/symbolbox.Rd 0000755 0001762 0000144 00000002034 14011145766 015042 0 ustar ligges users \name{symbolbox}
\alias{symbolbox}
\title{Draw a box filled with symbols}
\description{
Draws a box on the current figure that is filled with symbols
representing individual counts
}
\usage{
symbolbox(x1,y1,x2,y2,tot,relw=0.5,fg=par("fg"),bg=par("bg"),box=TRUE,
debug = TRUE,...)
}
\arguments{
\item{x1}{left side of box}
\item{y1}{bottom side of box}
\item{x2}{right side of box}
\item{y2}{top side of box}
\item{tot}{total number of symbols to put in the box}
\item{relw}{relative width (relative to height) of symbols}
\item{fg}{foreground color}
\item{bg}{background color}
\item{box}{(logical) draw box border?}
\item{debug}{debug output?}
\item{\dots}{additional arguments to polygon() for drawing box}
}
\details{
tries to automatically figure out appropriate scaling to fit symbols
into the box
}
\value{
none; draws on the current figure
}
\author{Ben Bolker}
\seealso{\link{multsymbolbox}}
\examples{
plot(1:10,1:10,type="n")
symbolbox(2,5,3,7,tot=20)
symbolbox(6,2,10,6,tot=50,fg="blue",bg="magenta")
}
\keyword{aplot}
plotrix/man/paxis3d.Rd 0000755 0001762 0000144 00000002706 14011145766 014405 0 ustar ligges users \name{paxis3d}
\alias{paxis3d}
\title{ Display text in the margins of a 3D plot }
\description{
Display text in the margins of a 3D plot.
}
\usage{
paxis3d(edge,pmat,at=NULL,labels=TRUE,tick=TRUE,
pos=NULL,nticks=5,ticklen=0.05,labdist=0.15,xpd=NA,...)
}
\arguments{
\item{edge}{ which axis to calculate.}
\item{pmat}{ matrix to transform coordinates. }
\item{at}{ position on the axis. }
\item{labels}{ labels to display in the margin. }
\item{tick}{ whether to draw axis tick marks. }
\item{pos}{ axis position relative to other axes. }
\item{nticks}{ number of tick marks. }
\item{ticklen}{ length of tick marks as a proportion of plot dimensions. }
\item{labdist}{ distance of labels from axis. }
\item{xpd}{ parameter to set plot clipping. }
\item{...}{ additional arguments passed to ptext3d. }
}
\value{nil}
\author{Ben Bolker}
\examples{
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)
## axis labels not drawn when axes=FALSE
paxis3d("X-",pp,at=c(1,2,9))
paxis3d("Y+",pp)
paxis3d("Z-",pp)
mtext3d("X-",pp,expression(alpha^sqrt(beta)))
## if you want labels parallel to axis, still have to figure out 'srt'
## by trial and error
mtext3d("Y+",pp,expression("velocity ("*gamma*", furlongs/fortnight)"),
xpd=NA,srt=6)
mtext3d("Z-",pp,"Range\n(r*)",dist=0.5)
}
\keyword{misc}
plotrix/man/propbrk.Rd 0000644 0001762 0000144 00000001610 14011145766 014477 0 ustar ligges users \name{propbrk}
\alias{propbrk}
\title{Calculate the proportion of specified values in a vector}
\description{
Calculates the proportion of values in a vector that are equal to a specified
value.
}
\usage{
propbrk(x,trueval=TRUE,na.rm=TRUE)
}
\arguments{
\item{x}{a character, factor or numeric vector.}
\item{trueval}{the value to be matched in \samp{x}.}
\item{na.rm}{whether to remove NA values.}
}
\details{
\samp{propbrk} calculates the proportion of values matching a specified value.
It is mainly to allow proportions to be calculated in the \samp{brkdnNest}
function. It always discards NAs in \samp{x} when summing the number equal to
\samp{trueval}, but respects the \samp{na.rm} argument when calculating the
total number of values in \samp{x}.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{brkdnNest}}
\examples{
propbrk(sample(LETTERS,100,TRUE),trueval="M")
}
\keyword{misc}
plotrix/man/spreadout.Rd 0000755 0001762 0000144 00000002452 14011145766 015036 0 ustar ligges users \name{spreadout}
\alias{spreadout}
\title{Spread out a vector of numbers to a minimum interval}
\description{
Spread out a vector of numbers so that there is a minimum interval
between any two numbers when in ascending or descending order.
}
\usage{
spreadout(x,mindist)
}
\arguments{
\item{x}{A numeric vector which may contain NAs.}
\item{mindist}{The minimum interval between any two values when in ascending
or descending order.}
}
\details{
\samp{spreadout} starts at or near the middle of the vector and increases the
intervals between the ordered values. NAs are preserved. \samp{spreadout}
first tries to spread groups of values with intervals less than \samp{mindist}
out neatly away from the mean of the group. If this doesn't entirely succeed,
a second pass that forces values away from the middle is performed.
\samp{spreadout} is currently used to avoid overplotting of axis tick labels
where they may be close together.
}
\value{
On success, the spread out values. If there are less than two valid
values, the original vector is returned.
}
\author{Jim Lemon}
\examples{
spreadout(c(1,3,3,3,3,5),0.2)
spreadout(c(1,2.5,2.5,3.5,3.5,5),0.2)
spreadout(c(5,2.5,2.5,NA,3.5,1,3.5,NA),0.2)
# this will almost always invoke the brute force second pass
spreadout(rnorm(10),0.5)
}
\keyword{misc}
plotrix/man/draw.arc.Rd 0000755 0001762 0000144 00000004106 14011145766 014527 0 ustar ligges users \name{draw.arc}
\alias{draw.arc}
\title{ Draw arc }
\description{
Draw one or more arcs using classic graphics.
}
\usage{
draw.arc(x=1,y=NULL,radius=1,angle1=deg1*pi/180,angle2=deg2*pi/180,
deg1=0,deg2=45,n=0.05,col=NA,lwd=NA,...)
}
\arguments{
\item{x}{ x coordinate of center. Scalar or vector. }
\item{y}{ y coordinate of center. Scalar or vector. }
\item{radius}{ radius. Scalar or vector. }
\item{angle1}{ Starting angle in radians. Scalar or vector. }
\item{angle2}{ Ending angle in radians. Scalar or vector. }
\item{deg1}{ Starting angle in degrees. Scalar or vector. }
\item{deg2}{ Ending angle in degrees. Scalar or vector. }
\item{n}{ Number of polygons to use to approximate the arc. }
\item{col}{ Arc colors. }
\item{lwd}{Line width for the arc.}
\item{...}{ Other arguments passed to segments. Vectorization
is not supported for these. }
}
\details{
Draws one or more arcs from \code{angle1} to \code{angle2}.
If \code{angle1} is numerically greater than \code{angle2},
then the angles are swapped.
Be sure to use an aspect ratio of 1 as shown in
the example to avoid distortion. For argument 'n' (which may be
either a scalar or a vector, although most likely you will leave
it at the default value), an integer value means to use that number
of segments to approximate the arc, while a non-integer value means
to use enough segments so that the angle that successive segments
make with one another is no more than n radians.
}
\value{
Returns a matrix of expanded arguments invisibly.
}
\author{Gabor Grothendieck. Improvements by Ted Toal.}
\examples{
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)
draw.arc(5, 5, 3, deg1=100, deg2=170, col="gold", lwd=50, lend=1)
# example taken from post by Hans Borcher:
# https://stat.ethz.ch/pipermail/r-help/2009-July/205728.html
# Note setting of aspect ratio to 1 first.
curve(sin(x), 0, pi, col="blue", asp=1)
draw.arc(pi/2, 0, 1, deg1=45, deg2=135, col="red")
}
\keyword{misc}
plotrix/man/getFigCtr.Rd 0000755 0001762 0000144 00000001722 14011145766 014705 0 ustar ligges users \name{getFigCtr}
\title{Get coordinates in the figure region in user units.}
\description{
Calculates the coordinates of a proportional point of the figure
region in user units.}
\usage{
getFigCtr(pos=c(0.5,0.5))
}
\arguments{
\item{pos}{The proportion of the figure region to find (see Details).}
}
\alias{getFigCtr}
\details{
\samp{getFigCtr} reads parameters about the current plot and calculates the
vertical and horizontal centers of the figure region by default. This is
typically useful for placing a centered title on plots where the left and
right margins are very different.
By changing \samp{pos}, any proportional points of the figure region can be
returned. For example, \samp{pos=c(0,0)} will return the left and bottom
coordinates of the figure region.
}
\value{A two element vector containing the coordinates of the center of the
figure region in user units.}
\author{Jim Lemon (thanks to Karl Brand for the adjustable coordinates)}
\keyword{misc}
plotrix/man/pasteCols.Rd 0000755 0001762 0000144 00000001572 14011145766 014767 0 ustar ligges users \name{pasteCols}
\alias{pasteCols}
\title{Paste the columns of a matrix together}
\description{Paste the columns of a matrix together to form as
many "words" as there are columns.}
\usage{
pasteCols(x,sep="")
}
\arguments{
\item{x}{A matrix.}
\item{sep}{The separator to use in the \samp{paste} command.}
}
\details{
\samp{pasteCols} pastes the columns of a matrix together to form a vector in
which each element is the concatenation of the elements in each of the columns
of the matrix. It is intended for producing identifiers from a matrix returned
by the \samp{combn} function.
}
\value{A vector of character strings.}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{makeIntersectList}}
\examples{
# create a matrix of the combinations of the first five letters of the
# alphabet taken two at a time.
alpha5<-combn(LETTERS[1:5],2,simplify=TRUE)
pasteCols(alpha5,sep="+")
}
plotrix/man/triax.fill.Rd 0000755 0001762 0000144 00000002616 14011145766 015106 0 ustar ligges users \name{triax.fill}
\alias{triax.fill}
\title{Triangle plot fill}
\description{
Fill a triangle plot with smaller triangles.
}
\usage{
triax.fill(col)
}
\arguments{
\item{col}{List of colors (see Details).}
}
\details{
In order for \samp{triax.fill} to fill an existing plot that has
been created by a call to \samp{triax.plot}, the user must supply
a list of fill colors. The first element of the list must begin with
at least one value that can be interpreted as a color. The second
element must begin with at least three such values, and so on, adding
two values for each element of the list. Each list element will be
displayed as a row of colored triangles starting at the top of the
plot. The number of elements in the list determines the number of
rows that will be displayed.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{triax.plot},\link{color.scale}}
\examples{
# the data will be something like response at different proportions
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))
# use some method of converting values to colors
fillcol<-sapply(fillval,function(x) {x*10+1} )
oldpar<-triax.plot(main="Test of triax.fill function")
triax.fill(fillcol)
par(oldpar)
}
\keyword{misc}
plotrix/man/triax.plot.Rd 0000755 0001762 0000144 00000007422 14011145766 015136 0 ustar ligges users \name{triax.plot}
\alias{triax.plot}
\title{Triangle plot}
\description{
Display a triangle plot with optional grid.
}
\usage{
triax.plot(x=NULL,main="",at=seq(0.1,0.9,by=0.1),
axis.labels=NULL,tick.labels=NULL,col.axis="black",cex.axis=1,
cex.ticks=1,
align.labels=TRUE,show.grid=FALSE,col.grid="gray",lty.grid=par("lty"),
cc.axes=FALSE,show.legend=FALSE,label.points=FALSE,point.labels=NULL,
col.symbols="black",pch=par("pch"),mar=c(5,2,4,2),no.add=TRUE,...)
}
\arguments{
\item{x}{Matrix where each row is three proportions or percentages
that must sum to 1 or 100 respectively.}
\item{main}{The title of the triangle plot. Defaults to nothing.}
\item{at}{The tick positions on the three axes.}
\item{axis.labels}{Labels for the three axes in the order left, right,
bottom. Defaults to the column names.}
\item{tick.labels}{The tick labels for the three axes as a list with
three components l, r and b (left, right and bottom).
Defaults to argument \samp{at} (proportions).}
\item{col.axis}{Color of the triangular axes, ticks and labels.}
\item{cex.axis}{Character expansion for axis labels.}
\item{cex.ticks}{Character expansion for the tick labels.}
\item{align.labels}{Logical - whether to align axis and tick labels with
the axes.}
\item{show.grid}{Whether to display grid lines at the ticks.}
\item{col.grid}{Color of the grid lines. Defaults to gray.}
\item{lty.grid}{Type of line for the grid.}
\item{cc.axes}{Whether axes and axis ticks should be clockwise or
counterclockwise.}
\item{show.legend}{Logical - whether to display a legend.}
\item{label.points}{Logical - whether to call \samp{thigmophobe.labels} to
label the points.}
\item{point.labels}{Optional labels for the points and/or legend.}
\item{col.symbols}{Color of the symbols representing each value.}
\item{pch}{Symbols to use in plotting values.}
\item{mar}{Margins for the triangle plot.}
\item{no.add}{Whether to restore the previous plotting parameters
(\samp{TRUE}) or leave them, allowing more points to be added.}
\item{...}{Additional arguments passed to \samp{points}.}
}
\details{
\samp{triax.plot} displays a triangular plot area on which proportions
or percentages are displayed. A grid or legend may also be displayed.
}
\note{
A three axis plot can only properly display one or more
sets of three proportions that each sum to 1 (or percentages that sum
to 100). Other values may be scaled to proportions (or percentages),
but unless each set of three sums to 1 (or 100), they will not plot
properly and \samp{triax.points} will complain appropriately. Note also
that \samp{triax.plot} will only display properly in a square plot,
which is forced by \samp{par(pty="s")}.
In case the user does want to plot values with different sums, the
axis tick labels can be set to different ranges to accomodate this.
\samp{triax.points} will still complain, but it will plot the values.
If planning to add points with \samp{triax.points} call \samp{triax.plot}
with \samp{no.add=FALSE} and restore plotting parameters after the
points are added.
}
\value{
A list containing \samp{xypos} (the \samp{x,y} positions plotted)
and \samp{oldpar} (the plotting parameters at the time \samp{triax.plot}
was called).
}
\author{
Jim Lemon - thanks to Ben Daughtry for the info on counterclockwise axes.
}
\seealso{
\link{triax.points}, \link{triax.abline}, \link{thigmophobe.labels}
}
\examples{
data(soils)
triax.plot(soils[1:10,],main="DEFAULT")
triax.plot(soils[1:10,],main="PERCENTAGES (Counterclockwise axes)",
tick.labels=list(l=seq(10,90,by=10),r=seq(10,90,by=10),b=seq(10,90,by=10)),
pch=3,cc.axes=TRUE)
triax.return<-triax.plot(soils[1:6,],main="GRID AND LEGEND",
show.grid=TRUE,show.legend=TRUE,col.symbols=1:6,pch=4)
# triax.plot changes a few parameters
par(triax.return$oldpar)
}
\keyword{misc}
plotrix/man/hexagon.Rd 0000755 0001762 0000144 00000001675 14011145766 014467 0 ustar ligges users \name{hexagon}
\alias{hexagon}
\title{Draw a hexagon}
\description{
Draws a hexagon on the current graphic device
}
\usage{
hexagon(x,y,unitcell=1,col=NA,border="black")
}
\arguments{
\item{x,y}{x and y position of the bottom left corner of the square that
would pack into the same space as the hexagon.}
\item{unitcell}{The dimension of the side of the abovementioned square.}
\item{col}{The color to fill the hexagon - default is no fill.}
\item{border}{The color of the perimeter of the hexagon.}
}
\note{
Draws a hexagon with the same center as a square that would pack into the
same dimensions as the hexagon. That is, given a grid of squares with
alternate rows shifted one half the length of the sides, the hexagons
drawn would be close packed. Its use in the plotrix package is to provide
an alternative unit cell for the \samp{color2D.matplot} function.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{color2D.matplot}}
\keyword{misc}
plotrix/man/violin_plot.Rd 0000644 0001762 0000144 00000006000 14011145766 015354 0 ustar ligges users \name{violin_plot}
\alias{violin_plot}
\title{Display a "violin" plot}
\description{Displays violin plots (rotated kernel density plots on each
side of boxplots).}
\usage{
violin_plot(X=rnorm(50),at,add=FALSE,na.rm=TRUE,bw,violin_width,
violin_end_width=0.005,equal_width=TRUE,show_box=TRUE,box_width=0.01,
box_col="black",show_outliers=TRUE,outlier_pch=NA,range=1.5,xlim,ylim,
axes=TRUE,ann=TRUE,xlab="",ylab="",x_axis_labels,main="Violin Plot",
col="red",median_col="white",show_mean=FALSE,mean_pch=19,
mean_pch_col="yellow",...)
}
\arguments{
\item{X}{A vector or matrix or data frame of numeric values.}
\item{at}{Horizontal position(s) for the violin plot(s).}
\item{add}{Whether this violin should be added to an existing plot.}
\item{na.rm}{Remove NA values. Passed to functions such as
\samp{boxplot} or \samp{density}.}
\item{bw}{Vector or bandwidth values for \samp{density}. Will be
recycled. If not provided then will be calculated using \samp{bw.nrd0}.}
\item{violin_width}{Multiplier to scale the width of the \samp{violin}.}
\item{violin_end_width}{Multiplier to scale the width of the ends of the
violin.}
\item{equal_width}{Should all violin widths be equal?}
\item{show_box}{Whether to display the box.}
\item{box_width}{Multiplier for the width of internal boxes.}
\item{box_col}{Fill color for the internal rectangle.}
\item{show_outliers}{Whther to display outliers as points.}
\item{outlier_pch}{Symbol for displaying outliers.}
\item{range}{Passed to \samp{boxplot}.}
\item{xlim,ylim}{Explicitly set the plot limits.}
\item{axes}{Logical value indicating whether both axes should be
drawn on the plot.}
\item{ann}{Annotate the plots with axis titles and overall titles.}
\item{xlab,ylab}{Labels for the X and Y axes.}
\item{x_axis_labels}{Labels for the violins.}
\item{main}{Title for the violin plot.}
\item{col}{Fill color for the violin(s). Will be recycled.}
\item{median_col}{Fill color for the median mark.}
\item{show_mean}{Whether to plot the mean as well as the median.}
\item{mean_pch}{Symbol to use for the mean.}
\item{mean_pch_col}{Fill color for the mean symbol.}
\item{...}{Extra arguments passed to \samp{polygon} used for
representing violin(s).}
}
\details{
\samp{violin_plot} displays one or more violin plots by drawing
rotated kernel density curves on each side of box plots.
}
\value{nil}
\author{Darshan Baral}
\examples{
# plotting a data frame
violin_plot(mtcars)
set.seed(42)
normvar<-c(rnorm(49),-3)
unifvar<-runif(50,-2,2)
normvar2<-rnorm(45)
# plotting a matrix
violin_plot(matrix(c(normvar,unifvar),ncol=2),
main="Default Plot",x_axis_labels=c("Normal","Uniform"))
# plotting with different colors and with at specified
violin_plot(matrix(c(normvar,unifvar),ncol=2),at=1:3,
main="Different colors and extra space",
x_axis_labels=c("Normal","Uniform","Normal"),
show_outliers=TRUE,col=c("blue","red"),median_col="lightgray",
pch=6)
# adding a violin to existing plot
violin_plot(normvar2,at=3,add=TRUE,col="green",violin_width=1)
}
\keyword{misc}
plotrix/man/clean.args.Rd 0000755 0001762 0000144 00000002243 14011145766 015043 0 ustar ligges users \name{clean.args}
\alias{clean.args}
\alias{remove.args}
\title{Remove inappropriate arguments from an argument list}
\description{
Takes a list of arguments and eliminates those that are not
appropriate for passing to a particular function (and hence
would produce an error if passed).
}
\usage{
clean.args(argstr,fn,exclude.repeats=FALSE,exclude.other=NULL,dots.ok=TRUE)
remove.args(argstr,fn)
}
\arguments{
\item{argstr}{a named list of arguments, e.g. from \samp{\dots}}
\item{fn}{a function}
\item{exclude.repeats}{(logical) remove repeated arguments?}
\item{exclude.other}{a character vector of names of additional arguments to remove}
\item{dots.ok}{should "..." be allowed in the argument list?}
}
\value{
\samp{clean.args} returns a list which is a copy of \samp{argstr} with
arguments inappropriate for \samp{fn} removed; \samp{remove.args}
removes the arguments for \samp{fn} from the list.
}
\author{Ben Bolker}
\examples{
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)
## add example of combining arg. lists?
}
\keyword{programming}
plotrix/man/rectFill.Rd 0000755 0001762 0000144 00000002342 14011145766 014572 0 ustar ligges users \name{rectFill}
\alias{rectFill}
\title{Draw a rectangle filled with symbols}
\description{
Draws a rectangle on the current figure filled with arbitrary symbols.
}
\usage{
rectFill(x1,y1,x2,y2,fg=par("fg"),bg=par("bg"),xinc=NA,yinc=NA,
pch=1,pch.cex=1,pch.col=par("fg"),...)
}
\arguments{
\item{x1,y1,x2,y2}{Rectangle limits as in \samp{rect}.}
\item{fg}{Foreground color}
\item{bg}{Background color}
\item{xinc,yinc}{The x and y increments of spacing for the symbols.}
\item{pch}{Which symbol to use}
\item{pch.cex}{Character expansion for the symbols.}
\item{pch.col}{Color(s) for the symbols. }
\item{...}{Additional arguments to \samp{points} for the symbols.}
}
\details{
\samp{rectFill} draws a rectangle and fills the rectangle with the
symbols requested. It is probably most useful as a substitute for
fill colors in a black and white environment.
}
\value{ nil }
\author{Jim Lemon}
\seealso{\link{rect}, \link{points}}
\examples{
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)
barp(matrix(runif(9),nrow=3),main="Black and white bar plot",pch=1:3)
}
\keyword{misc}
plotrix/man/ehplot.Rd 0000644 0001762 0000144 00000004473 14011145766 014325 0 ustar ligges users \name{ehplot}
\alias{ehplot}
%- Also NEED an '\alias' for EACH other topic documented here.
\title{
Engelmann-Hecker-Plot - EH-Plot
}
\description{
This R function provides a convenient way to visualize the distribution of
grouped numerical data.
}
\usage{
ehplot(data, groups, intervals=50, offset=0.1, log=FALSE,
median=TRUE, box=FALSE, boxborder="grey50",
xlab="groups", ylab="values", col="black",
add=FALSE, sort=TRUE, ...)
}
\arguments{
\item{data}{
Vector of numerical data.
}
\item{groups}{
Vector of group names which should have the same length as data.
}
\item{intervals}{
The data is splitted into a certain number of intervals. If data
points are in the same interval they are drawn side-by-side.
}
\item{offset}{
x-distance between two data points at the same interval.
}
\item{log}{
Logarithmic display
}
\item{median}{
To show the median of each group. NAs in data are not considered
for calculating the medians.
}
\item{box}{
To underlay a boxplot.
}
\item{boxborder}{
The color of the boxplot if a boxplot is drawn.
}
\item{xlab}{
x-axis label
}
\item{ylab}{
y-axis label
}
\item{col}{
vector of colors for the datapoints. (recycled as necessary).
}
\item{add}{
add this plot to an existing one (i.e. do not call plot.new).
}
\item{sort}{
normally, the groups are sorted by name. To keep the order as provided in
the groups-vector, set this to FALSE
}
\item{\dots}{
additional plot-parameters will be passed to the plot-function
}
}
\author{
Robby Engelmann and
Michael Hecker
}
\examples{
data(iris)
ehplot(iris$Sepal.Length, iris$Species, intervals=20, cex=1.8, pch=20)
ehplot(iris$Sepal.Width, iris$Species, intervals=20, box=TRUE, median=FALSE)
ehplot(iris$Petal.Length, iris$Species, pch=17, col="red", log=TRUE)
ehplot(iris$Petal.Length, iris$Species, offset=0.06, pch=as.numeric(iris$Species))
# Groups don't have to be presorted:
rnd <- sample(150)
plen <- iris$Petal.Length[rnd]
pwid <- abs(rnorm(150, 1.2))
spec <- iris$Species[rnd]
ehplot(plen, spec, pch=19, cex=pwid, col=rainbow(3, alpha=0.6)[as.numeric(spec)])
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ misc }
plotrix/man/valid.n.Rd 0000755 0001762 0000144 00000001013 14011145766 014353 0 ustar ligges users \name{valid.n}
\alias{valid.n}
\title{
Find the number of valid (not NA) values
}
\description{
Finds the number of valid (not NA) or total values in an object.
}
\usage{
valid.n(x,na.rm=TRUE)
}
\arguments{
\item{x}{An object.}
\item{na.rm}{Whether to count all values (FALSE) or only those not NA.}
}
\details{
\samp{valid.n} finds the number of valid values of the object if \samp{na.rm=TRUE}.
}
\value{The number of valid values or the length of the object.}
\author{Jim Lemon}
\keyword{misc}
plotrix/man/textbox.Rd 0000755 0001762 0000144 00000005555 14011145766 014534 0 ustar ligges users \name{textbox}
\alias{textbox}
\title{Add text box}
\description{
Add text to plot, justified, in a box
}
\usage{
textbox(x, y, textlist, justify=c('l','c','r'), cex=1, leading=0.5, box=TRUE,
adj=c(0,0), font=NULL, vfont=NULL, col=NULL, border=NULL, fill=NA, density=NULL,
angle=45, lty=par("lty"), lwd=par("lwd"), margin=0)
}
\arguments{
\item{x}{x position: a vector with min. and max. x-position}
\item{y}{y position: location of the top of the box}
\item{textlist}{a vector of text strings}
\item{justify}{x alignment: 'l'=left, 'c'=center, 'r'=right.}
\item{cex}{character expansion}
\item{leading}{inter-line spacing}
\item{box}{whether to draw a box around the text}
\item{adj}{adjustment for x and y position, default is no adjustment,
see Details}
\item{font}{text font, see Details}
\item{vfont}{text font, see Details}
\item{col}{text color}
\item{border}{box border color}
\item{fill}{box fill color}
\item{density}{box shading line density, see Details}
\item{angle}{box shading line angle, see Details}
\item{lty}{box border and shading line types, see Details}
\item{lwd}{box border and shading line width, see Details}
\item{margin}{amount to adjust box border in or out. See Details}
}
\details{
Draws text in the box by pasting the textlist vector together, splitting it
into words, and then adding words to the current line until the line is wide
enough before moving on to the next line.
\samp{margin} may be a vector of 1, 2, or 4 values, corresponding to
adjustment of all borders (1 value), top/bottom and left/right borders
(2 values), or bottom/left/top/right borders (4 values). A positive value
moves text inwards from specified (x,y) position with border remaining at (x,y),
and a negative value moves the border outwards from (x,y) with the text
remaining at (x,y).
The \samp{density} and \samp{angle} arguments have the same behavior as in the
\samp{rect} function. The \samp{adj, font} and {vfont} arguments have the same
behavior as in the \samp{text} function. The \samp{lty} and \samp{lwd}
arguments have the same behavior as in the \samp{lines} function.
}
\value{
y-position of bottom line of box, or y-position of next line if there is no box.
}
\author{Ben Bolker. Improvements by Ted Toal.}
\examples{
plot.new()
textbox(c(0,0.2), 1, c("many words","more words","why not?",
"keep going",rep("and going",10)))
textbox(c(0.3,0.5), 1, c("keep going",rep("and going",10)), cex=0.45,
col="blue", border="red", fill="#00FFEE80", density=25, angle=60)
textbox(c(0.6,0.8), 1, c("keep going",rep("and going",10)), justify='c', cex=0.6,
leading=1, font=4, border="gold", lty=2, lwd=4, margin=0.025)
textbox(c(0.6,0.8), 0.5, c("keep going",rep("and going",10)), justify='r', cex=0.7,
col="purple", font=3, border="green", margin=-0.025)
lines(c(0,1), c(1,1), col="red", lty=2)
lines(c(0,1), c(0.5,0.5), col="red", lty=2)
}
\keyword{aplot}
plotrix/man/staircase.plot.Rd 0000755 0001762 0000144 00000007260 14011145766 015765 0 ustar ligges users \name{staircase.plot}
\alias{staircase.plot}
\title{Display a staircase plot}
\description{
Displays a plot showing a sequence of changing totals and increments as
successive linked bars.
}
\usage{
staircase.plot(heights,totals=NA,labels=NULL,halfwidth=0.3,main="",
mar=NA,total.col="blue",inc.col=NA,bg.col=NA,direction="e",las=1,
display.height=TRUE,stagger=FALSE,cex=par("cex"),prefix="",suffix="",...)
}
\arguments{
\item{heights}{vector of numeric values or a matrix or data frame with at least
two columns. The first column must be numeric and the second may be numeric or
logical.}
\item{totals}{A vector of logicals or zero/non-zero values indicating whether
the corresponding height is a total (TRUE) or an increment (FALSE).}
\item{labels}{An optional vector of labels for the bars.}
\item{halfwidth}{Half of the width of a bar as a proportion. See Details.}
\item{main}{A title for the plot.}
\item{mar}{Margins for the plot. Defaults to 10 on the baseline axis, 3 on the
top and 1 on the other two sides.}
\item{total.col}{Color(s) for the bars representing successive totals.}
\item{inc.col}{Color(s) for the bars representing increments.}
\item{bg.col}{The background color for the plot.}
\item{direction}{Direction in which the bars should be presented. See Details.}
\item{las}{Orientation for the bar labels. See \samp{par}.}
\item{display.height}{Whether to display the totals and increments at the upper
ends of the bars. Defaults to TRUE.}
\item{stagger}{Whether to stagger the labels to avoid overlap.}
\item{cex}{The usual character expansion value.}
\item{prefix}{A prefix to the numbers displayed next to the bars (e.g. $).}
\item{suffix}{A suffix as for prefix (e.g. \%).}
\item{...}{arguments passed to \samp{plot}.}
}
\value{nil}
\details{
Displays a plot representing successive changes in counts or values. For example,
if a research study attempts to contact a certain number of people and some
cannot be contacted, some decline to participate, some are ineligible, the final
sample will be smaller than the initial contact list. The first value will be the
total of attempts, there will be a number of decrements, and the last value will
be the actual sample. There may be intermediate totals specified. This produces
a visual display of the sampling procedure. See the example.
The bars are placed at integer values on the axis representing the succession of
counts or values. The width of the bars is determined by the argument
\samp{halfwidth}. This defaults to 0.3, meaning that the bar extends 0.3 to each
side, so that the proportion of bar to space is 0.6 to 0.4. The succession of
bars is determined by the \samp{direction} argument. The default is "e" (east),
meaning that the first bar is at the left of the plot and subsequent bars are
placed to the right. The other three possibilities follow the conventional
compass layout.
The \samp{prefix} and \samp{suffix} arguments allow the user to specify units
for the numbers displayed next to the bars. If a single value is passed, all
numbers will get the same prefix or suffix. Different prefixes or suffixes for
each number can be passed as vectors.
The \samp{getFigCtr} function is called to center the plot title in the figure
region as the plot area is typically off center.
}
\author{Jim Lemon}
\seealso{\link{plot}, \link{getFigCtr}}
\examples{
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")
}
\keyword{misc}
plotrix/man/getMarginWidth.Rd 0000755 0001762 0000144 00000002227 14011145766 015745 0 ustar ligges users \name{getMarginWidth}
\alias{getMarginWidth}
\title{Find the margin width necessary to fit text or a legend next to a plot}
\description{
Calculates the margin width necessary to fit text or a legend next to a plot.
}
\usage{
getMarginWidth(side=4,labels,is.legend=FALSE)
}
\arguments{
\item{side}{Which side of the plot (as in axis).}
\item{labels}{The text to place next to the plot.}
\item{is.legend}{Whether the text is in a legend or not.}
}
\details{
\samp{getMarginWidth} reads parameters about the current plot and calculates the
left or right (default) margin necessary to fit the strings passed as
\samp{labels} or a legend containing those strings.
}
\value{
A two element list containing the number of margin lines necessary to
fit the text or legend and the horizontal center of the margin in user units.
}
\author{Jim Lemon}
\examples{
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)
}
\keyword{misc}
plotrix/man/oz.windrose.Rd 0000755 0001762 0000144 00000004365 14011145766 015316 0 ustar ligges users \name{oz.windrose}
\alias{oz.windrose}
\title{Display an Australian wind rose}
\description{Displays a wind rose in the style used by the Australian
Bureau of Meteorology.}
\usage{
oz.windrose(windagg,maxpct=20,wrmar=c(4,5,6,5),scale.factor=30,
speed.col=c("#dab286","#fe9a66","#ce6733","#986434"),
speed.width=NA,show.legend=TRUE,legend.pos=NA,...)
}
\arguments{
\item{windagg}{A matrix of percentages with the rows representing
speed ranges and the columns indicating wind directions.}
\item{maxpct}{The maximum percentage displayed on the radial grid.}
\item{wrmar}{Plot margins for the diagram.}
\item{scale.factor}{The scale factor for the diagram.}
\item{speed.col}{Colors representing speed ranges.}
\item{speed.width}{Half widths of the bars representing speed ranges.}
\item{show.legend}{Logical indicating whether to display a legend.}
\item{legend.pos}{The vertical position of the wind rose legend. The
Australian Bureau of Meteorology displays the legend at the top of
the plot}
\item{...}{additional arguments passed to \samp{plot}.}
}
\details{
\samp{oz.windrose} displays a wind rose in the style used by the Australian
Bureau of Meteorology. Each limb represents a bin of wind directions, and
there are conventionally eight bins. If \samp{windagg} has more than eight
columns, more limbs will be displayed. The rows of \samp{windagg} represent
the speed ranges used by the Australian Bureau of Meteorology (0, 0-10,
10-20, 20-30 and over 30 in km/hour). The diameter of the central circle is
calculated as (percent calm observations)/(number of direction bins). The
remaining grid circles are spaced from the circumference of the "Calm"
circle.
}
\note{
If a title is desired, remember to move the legend to the bottom
of the plot. If the function is passed values that do not sum to 100, the
resulting plot will at best be misleading.
}
\value{nil}
\author{Jim Lemon (thanks to Anna in the Sydney BoM office and Alejo for
finding the problem with heavily prevailing winds.)}
\seealso{\link{oz.windrose.legend}, \link{draw.circle}, \link{bin.wind.records}}
\examples{
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)
}
\keyword{misc}
plotrix/man/color.id.Rd 0000755 0001762 0000144 00000000772 14011145766 014544 0 ustar ligges users \name{color.id}
\alias{color.id}
\title{Identify closest match to a color}
\description{
Given a color specified as a hex string, find the closest match in the
table of known (named) colors
}
\usage{
color.id(col)
}
\arguments{
\item{col}{a color specified as a hex string}
}
\details{
finds the color with the minimum squared distance in RGB space
}
\value{
the name of the closest match
}
\author{Ben Bolker}
\seealso{\link{col2rgb},\link{colors}}
\examples{
color.id("#cc00cc")
}
\keyword{color}
plotrix/man/maxEmptyRect.Rd 0000644 0001762 0000144 00000002743 14011145766 015452 0 ustar ligges users \name{maxEmptyRect}
\alias{maxEmptyRect}
\title{ Find an empty space on a plot }
\description{
Try to find the largest empty rectangle on a plot.
}
\usage{
maxEmptyRect(ax,ay,x,y)
}
\arguments{
\item{ax,ay}{The rectangle within which all of the points are contained.
Usually the limits of a plot.}
\item{x,y}{x and y positions of the points.}
}
\details{
\samp{maxEmptyRect} searches the pairs of points on the plot to find
the largest rectangular space within which none of the points lie.
It does not guarantee that the space will be large enough to fit a
legend or text.
Two alternatives are the \samp{largest.empty} function in the
\pkg{Hmisc} package and the \samp{emptyspace} function. \samp{maxEmptyRect}
appears to outperform \samp{emptyspace}, particularly in running time.
However, \samp{emptyspace} will sometimes find a "squarer" rectangle when
\samp{maxEmptyRect} finds a slightly larger narrow rectangle.
}
\value{
A list containing the area of the rectangle and the coordinates of the
lower left and upper right corners (as used in \samp{rect}) of the rectangle
found.
}
\author{Hans Borchers}
\references{
A. Naamad, D. T. Lee, and W.-L. Hsu (1984). On the Maximum Empty
Rectangle Problem. Discrete Applied Mathematics, 8: 267-277.
}
\examples{
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")
}
\keyword{misc}
plotrix/man/boxed.labels.Rd 0000755 0001762 0000144 00000005714 14011145766 015376 0 ustar ligges users \name{boxed.labels}
\alias{boxed.labels}
\title{ Place labels in boxes }
\description{
Places labels in boxes on an existing plot
}
\usage{
boxed.labels(x,y=NULL,labels,
bg=ifelse(match(par("bg"),"transparent",0),"white",par("bg")),
border=TRUE,xpad=1.2,ypad=1.2,srt=0,cex=1,adj=0.5,xlog=FALSE,ylog=FALSE,...)
}
\arguments{
\item{x,y}{x and y position of the centers of the labels. \samp{x} can be an
\link{xy.coords} list.}
\item{bg}{The fill color of the rectangles on which the labels are displayed
(see Details).}
\item{labels}{Text strings}
\item{border}{Whether to draw borders around the rectangles.}
\item{xpad,ypad}{The proportion of the rectangles to the
extent of the text within.}
\item{srt}{Rotation of the labels. If 90 or 270 degrees, the box will be
rotated 90 degrees.}
\item{cex}{Character expansion. See \samp{text}.}
\item{adj}{left/right adjustment. If this is set outside the function,
the box will not be aligned properly.}
\item{xlog}{Whether the X axis is a log axis}
\item{ylog}{Whether the Y axis is a log axis}
\item{...}{additional arguments passed to \samp{text}.}
}
\details{
The label(s) are displayed on a rectangular background. This may be useful
for visibility and is the reason that "transparent" background is not available.
With the default \samp{textcol=NA}, the function tries to work out whether white
or black text will be more easily read based on the background color and displays
the text accordingly. If the user specifies text colors in the additional
arguments, these colors will override the automatic white/black above - see the
last example.
Only right angle rotations are allowed in \samp{boxed.labels}. \emph{Important
change}: \samp{xpad} and \samp{ypad} are now the full proportion of
the box to text, not half. The user can now call \samp{cylindrect} or
\samp{gradient.rect} for the background rectangle.
}
\note{
This function is best for regularly spaced labels where overlapping is
not a problem. See \link{thigmophobe.labels} for placing labels
where overlap is likely.
}
\value{nil}
\author{Jim Lemon - thanks to Thorn Thaler for the code allowing
user-specified text colors and Flemming Skjoth for the log axis correction}
\seealso{\link{spread.labels}, \link{thigmophobe.labels}}
\examples{
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)
# now label a barplot
xpos<-barp(c(1,3,2,4))
boxed.labels(xpos$x,0.5,nums[1:4])
# and add labels below the x axis ticks
boxed.labels(xpos$x,-0.4,c("First","Second","Third","Fourth"))
# perform a PCA on the "swiss" dataset and plot the first two components
data(swiss)
swiss.pca<-prcomp(swiss)
plot(swiss.pca$rotation[,1:2],xlim=c(-1,0.2),main="PCA of swiss dataset",
type="n")
boxed.labels(swiss.pca$rotation[1:6],swiss.pca$rotation[7:12],ypad=1.5,
colnames(swiss),bg=c("red","purple","blue","blue","darkgreen","red"),
col="yellow")
}
\keyword{misc}
plotrix/man/staxlab.Rd 0000755 0001762 0000144 00000003636 14011145766 014473 0 ustar ligges users \name{staxlab}
\alias{staxlab}
\title{ Place staggered or angled labels on an axis }
\description{
Places labels on an axis in a regular staggered order or at an angle
}
\usage{
staxlab(side=1,at,labels,nlines=2,top.line=0.5,line.spacing=0.8,
srt=NULL,ticklen=0.03,adj=1,...)
}
\arguments{
\item{side}{axis on which to place the labels, as in \samp{axis}}
\item{at}{where to place the labels in user units, as in \samp{axis}}
\item{labels}{text strings}
\item{nlines}{How many lines to use to stagger the labels.}
\item{top.line}{Distance from the axis to place the first line of text.}
\item{line.spacing}{Spacing between lines of text labels.}
\item{srt}{Text rotation.}
\item{ticklen}{Proportion of plot height in user units to place text
below the plot.}
\item{adj}{horizontal adjustment of the labels.}
\item{...}{Additional arguments to be passed to \samp{mtext} or \samp{text}.}
}
\note{
This function is mainly useful when either long axis labels or a large
number of labels are to be placed without overlapping. It staggers the
labels along the axis specified. The user may wish to increase the space
beneath the plot using \samp{mar} before calling \samp{staxlab}. It is
probably only useful on the bottom or left side of the plot.
If \samp{srt} is not NULL, the labels will be rotated \samp{srt} degrees
and placed below the plot. This method will only place labels at the
bottom. Note that this option only works on the lower and left axes.
}
\value{nil}
\author{Jim Lemon (thanks to Tim Elwell-Sutton for the log axis fix)}
\seealso{\link{mtext}}
\examples{
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)
plot(x,axes=FALSE)
box()
staxlab(1,1:12,months,srt=45)
ylabels<-round(seq(min(x),max(x),length.out=10),3)
staxlab(2,ylabels,ylabels,srt=45)
}
\keyword{misc}
plotrix/man/tab.title.Rd 0000755 0001762 0000144 00000002504 14011145766 014714 0 ustar ligges users \name{tab.title}
\alias{tab.title}
\title{
Display the title of a plot as a colored tab
}
\description{
Display the title of a plot as a colored tab.
}
\usage{
tab.title(label,text.col=par("fg"),tab.col=par("bg"),border=par("fg"),
lwd=par("lwd"),cex=1.5,pad.mult=1.6,radius=0)
}
\arguments{
\item{label}{The title for the plot.}
\item{text.col}{The color for the title text.}
\item{tab.col}{The color for the tab fill.}
\item{border}{The color for the tab border.}
\item{lwd}{The line width for the border.}
\item{cex}{Character expansion for the title.}
\item{pad.mult}{How much higher to make the tab relative to the label.}
\item{radius}{What proportion of the tab corners to round off.}
}
\value{
nil
}
\details{
\samp{tab.title} displays the plot title in a colored tab. The tab can be
rounded at the upper corners by specifying the proportion of the tab
height to be rounded as a number between 0 and 1. If the tab is too high
to fit on the figure region, a warning will be displayed and the tab will
still be shown.
}
\author{Jim Lemon}
\seealso{\link{polygon}}
\examples{
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)
}
\keyword{misc}
plotrix/man/clock24.plot.Rd 0000755 0001762 0000144 00000004272 14110376236 015246 0 ustar ligges users \name{clock24.plot}
\title{Plot values on a 24 hour "clockface"}
\usage{
clock24.plot(lengths,clock.pos,labels=0:23,minutes=FALSE,
hm2dec=FALSE,label.pos=NULL,rp.type="r",loglen=FALSE,explab=FALSE,...)
}
\alias{clock24.plot}
\arguments{
\item{lengths}{numeric data vector. Magnitudes will be represented as
line lengths, or symbol or polygon vertex positions.}
\item{clock.pos}{numeric vector of positions on the 'clockface'.
These must be in decimal hours and will be rescaled to radians.}
\item{labels}{Labels to place at the circumference.}
\item{minutes}{Whether to add minutes (".00") to the labels.}
\item{hm2dec}{Whether to convert HH:MM clock positions to decimal hours.}
\item{label.pos}{Radial positions of the labels.}
\item{rp.type}{Whether to plot radial lines, symbols or a polygon.}
\item{loglen}{Whether to log transform the \samp{length} values. Only base
10 logs are available.}
\item{explab}{Whether to use the default fixed (FALSE) or exponential (TRUE)
notation for the radial labels.}
\item{...}{additional arguments are passed to \samp{radial.plot} and
then to \samp{plot}.}
}
\description{
\samp{clock24.plot} displays a plot of radial lines, symbols or a polygon
centered at the midpoint of the plot frame on a 24 hour 'clockface'.
In contrast to the default behavior of \samp{radial.plot}, the positions
are interpreted as beginning at vertical (000) and moving clockwise.
If \samp{add=TRUE} is passed as one of the additional arguments, the values
will be added to the current plot. If a \samp{radial.lim} argument was
passed on the initial plot, it must be passed again to add values or the
values will be displayed incorrectly.
}
\value{A list of the parameters altered by \link{radial.plot}.}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{polar.plot},\link{radial.plot}}
\examples{
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(dev.interactive()) par(ask=TRUE)
# now do a 'daylight' plot
oldpar<-clock24.plot(testlen[7:19],testpos[7:19],
main="Test Clock24 daytime (symbols)",
point.col="blue",rp.type="s",lwd=3)
# reset everything
par(oldpar)
}
plotrix/man/revaxis.Rd 0000755 0001762 0000144 00000002461 14011145766 014511 0 ustar ligges users \name{revaxis}
\alias{revaxis}
\title{ Plot with axis direction(s) reversed }
\description{
Reverses the sense of either or both the \samp{x} and \samp{y} axes.
}
\usage{
revaxis(x, y, xrev=FALSE, yrev=TRUE, xside=if (yrev) 3 else 1,
yside=if (xrev) 4 else 2, xlab=NULL, ylab=NULL, bty=NULL, ...)
}
\arguments{
\item{x}{ Vector of \samp{x}-coordinates of the data to be plotted. }
\item{y}{ Vector of \samp{y}-coordinates of the data to be plotted. }
\item{xrev}{ Logical scalar; should the sense of the \samp{x}-axis
be reversed?}
\item{yrev}{ Logical scalar; should the sense of the \samp{y}-axis
be reversed?}
\item{xside}{ The side of the plot on which the \samp{x}-axis labels
should go.}
\item{yside}{ The side of the plot on which the \samp{y}-axis labels
should go.}
\item{xlab}{ Character string for labelling the \samp{x}-axis. }
\item{ylab}{ Character string for labelling the \samp{y}-axis. }
\item{bty}{ Single letter indicating the type of box to be drawn
around the plot. See \link{par} for the possible letters
and their meaning.}
\item{\dots}{ Other arguments to be passed to plot.}
}
\value{ nil }
\author{Rolf Turner}
\seealso{ \link{plot}, \link{box}, \link{par}}
\examples{
x <- runif(20)
y <- runif(20)
revaxis(x,y,yside=4)
}
\keyword{ hplot }
plotrix/man/size_n_color.Rd 0000644 0001762 0000144 00000007600 14011145766 015512 0 ustar ligges users \name{size_n_color}
\alias{size_n_color}
\title{Display circles with specified size and color}
\description{Display a plot of circles at specified locations, each with a
specified size and color.}
\usage{
size_n_color(x=NULL,y,size,sizefun="sqrt",col,main="",
xlim=NA,xlab="",xat=NULL,xaxlab=NULL,xcex=1,xlas=0,xgrid=FALSE,
ylim=NA,ylab="",yat=NULL,yaxlab=NULL,ycex=1,ylas=1,ygrid=TRUE,
mar=c(5,4,4,2),boxit=TRUE,add=FALSE,...)
}
\arguments{
\item{x,y}{Vectors or matrices of x and y positions for the symbols.}
\item{size}{Sizes for the symbols expressed as numbers.}
\item{sizefun}{The function to use for transforming the values to radii
of circles. Square root gives areas proportional to the values.}
\item{col}{Colors for the symbols (see Details).}
\item{main}{Title for the plot.}
\item{xlim,ylim}{Explicit x and y limits for the plot}.
\item{xlab,ylab}{Labels for the x and y axes.}
\item{xat,yat}{Where to place the ticks and tick labels on the axes.}
\item{xaxlab,yaxlab}{Tick labels for the x and y axes.}
\item{xcex,ycex}{Character expansions for the axis tick labels.}
\item{xlas,ylas}{Orientation for the axis tick labels (see \samp{par}).}
\item{xgrid,ygrid}{Whether to display a grid along the x or y direction.}
\item{mar}{Margins for the plot (see Details).}
\item{boxit}{Whether to draw a box around the plot.}
\item{add}{Whether to draw a new plot (FALSE) or add symbols to an existing
plot (TRUE).}
\item{...}{Additional arguments passed to \samp{plot}.}
}
\details{
\samp{size_n_color} plots circles centered on the \samp{x} and \samp{y}
coordinates. The size and color of the circles may also be specified
individually, allowing four dimensions of variation to be displayed on the
plot.
\samp{size_n_color} may also be used to display a "visual table" as in the second
example. Here the x and y coordinates are used to associate the symbols with
two categorical variables, underlying cause of death and year of observation.
If the x values are not passed to the function, it will try to space out the
circles evenly in a representation of the matrix. If the matrix is not square,
use a plotting device that has about the same proportion of height and width as
the matrix.
}
\value{nil}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{plot}, \link{points}, \link{par}}
\examples{
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)
# now display a "visual table" of delayed registrations by underlying cause of
# death and year of observation. The sizes of the circles represent the log of
# the number of deaths and the colors represent the percentage of deaths that
# occurred in the year prior to registration or earlier
data(death_reg)
size_n_color(x=matrix(rep(1996:2010,each=22),nrow=22),
y=matrix(rep(1:22,15),nrow=22),size=t(death_reg[[1]])/200,
col=color.scale(t(death_reg[[2]]),c(0,0.8,1),c(1,0.2,0),0),
ylim=c(1,22),main="Delayed registrations by ICD chapter",
xlab="Year",xaxlab=1996:2010,xat=1996:2010,xcex=0.8,
yaxlab=colnames(death_reg[[1]]),ycex=0.8,ygrid=TRUE,mar=c(5,6,4,2))
color.legend(1994,-3.5,2000,-2.5,seq(0,50,by=10),cex=0.8,
rect.col=color.scale(seq(0,50,by=10),c(0,0.8,1),c(1,0.2,0),0))
par(xpd=TRUE)
text(1993.4,-2.5,"Pct.\nslow",cex=0.8)
par(xpd=FALSE)
}
plotrix/man/cluster.overplot.Rd 0000755 0001762 0000144 00000003541 14011145766 016362 0 ustar ligges users \name{cluster.overplot}
\alias{cluster.overplot}
\title{Shift overlying points into clusters}
\usage{
cluster.overplot(x,y,away=NULL,tol=NULL,...)
}
\arguments{
\item{x,y}{Numeric data vectors or the first two columns of a matrix
or data frame. Typically the x/y coordinates of points to be plotted.}
\item{away}{How far to move overlying points in user units. Defaults to
the width of a lower case "o" in the x direction and 5/8 of the
height of a lower case "o" in the y direction. Must have both values.}
\item{tol}{The largest distance between points that will be considered
to be overlying. Defaults to 1/2 of the width of a lower case "o" in
the x direction and 1/2 of the height of a lower case "o" in the y
direction.}
\item{...}{additional arguments returned as they are passed.}
}
\description{
\samp{cluster.overplot} checks for overlying points in the x and y
coordinates passed. Those points that are overlying are moved to form
a small cluster of up to nine points. For large numbers of overlying
points, see \link{count.overplot} or \link{sizeplot}.
If you are unsure of the number of overplots in your data, run
\samp{count.overplot} first to see if there are any potential clusters
larger than nine.
}
\value{
A list with two components. For unique x-y pairs the elements will be
the same as in the original. For overlying points up to eight additional
points will be generated that will create a cluster of points instead of one.
}
\keyword{misc}
\author{Jim Lemon - thanks to Markus Elze for the test for a current graphics
device}
\seealso{\link{count.overplot},\link{sizeplot}}
\examples{
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),
away=rep(0.2,2))
plot(clusteredpoints,col=clusteredpoints$col,
main="Cluster overplot test")
}
plotrix/man/drawSectorAnnulus.Rd 0000644 0001762 0000144 00000001271 14011145766 016506 0 ustar ligges users \name{drawSectorAnnulus}
\alias{drawSectorAnnulus}
\title{Display a radial pie sector}
\description{
Displays a radial pie sector with optional annuli.
}
\usage{
drawSectorAnnulus(angle1,angle2,radius1,radius2,col,angleinc=0.03)
}
\arguments{
\item{angle1,angle2}{Start and end angle for the sector.}
\item{radius1,radius2}{Start and end of the radial extent of the annulus.}
\item{col}{Color of the sector.}
\item{angleinc}{The angular increment to use in drawing the arcs.}
}
\value{nil}
\details{
\samp{drawSectorAnnulus} displays a single radial pie sector. It is probably
only useful when called from \link{radial.pie}.
}
\author{Jim Lemon}
\seealso{\link{radial.pie}}
\keyword{misc}
plotrix/man/get.triprop.Rd 0000755 0001762 0000144 00000001734 14011145766 015307 0 ustar ligges users \name{get.triprop}
\alias{get.triprop}
\title{Enter three proportion data - usually soil textures}
\usage{
get.triprop(use.percentages=FALSE,cnames=c("1st","2nd","3rd"))
}
\arguments{
\item{use.percentages}{Logical - whether to treat the entries as
percentages and scale to proportions.}
\item{cnames}{column names for the resulting three column matrix.}
}
\description{
\samp{get.triprop} allows the user to enter triplets of proportions
or percentages of three components such as sand, silt and clay in soils.
}
\details{
The three proportions of each row must sum to 100 or 1 within 1\% or
the function will warn the operator.}
\value{A matrix of the components of one or more observations.}
\author{Jim Lemon}
\seealso{\link{triax.plot}, \link{soil.texture}}
\examples{
if(dev.interactive()) {
# get some proportions
newsp<-get.triprop()
# show the triangle
triax.frame(main="Test triax.plot")
# now plot the observations
triax.points(newsp)
}
}
\keyword{misc}
plotrix/man/gap.barplot.Rd 0000755 0001762 0000144 00000003335 14011145766 015242 0 ustar ligges users \name{gap.barplot}
\alias{gap.barplot}
\title{
Display a barplot with a gap (missing range) on one axis
}
\description{
Displays a barplot with a missing range.
}
\usage{
gap.barplot(y,gap,xaxlab,xtics,yaxlab,ytics,xlim=NA,ylim=NA,xlab=NULL,
ylab=NULL,horiz=FALSE,col,...)
}
\arguments{
\item{y}{a vector of data values}
\item{gap}{the range of values to be left out}
\item{xaxlab}{labels for the x axis ticks}
\item{xtics}{position of the x axis ticks}
\item{yaxlab}{labels for the y axis ticks}
\item{ytics}{position of the y axis ticks}
\item{xlim}{Optional x limits for the plot}
\item{ylim}{optional y limits for the plot}
\item{xlab}{label for the x axis}
\item{ylab}{label for the y axis}
\item{horiz}{whether to have vertical or horizontal bars}
\item{col}{color(s) in which to plot the values}
\item{...}{arguments passed to \samp{barplot}.}
}
\value{
The center positions of the bars.
}
\details{
Displays a barplot omitting a range of values on the X or Y axis. Typically
used when there is a relatively large gap in the range of values
represented as bar heights. See \link{axis.break} for a brief
discussion of plotting on discontinuous coordinates.
If the user does not ask for specific y limits, the function will calculate
limits based on the range of the data values. If passing specific limits,
remember to subtract the gap from the upper limit.
}
\author{Jim Lemon}
\seealso{\link{gap.barplot}}
\examples{
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="Barplot with gap")
gap.barplot(twogrp,gap=c(8,16),xlab="Index",ytics=c(3,6,17,20),
ylab="Group values",horiz=TRUE,main="Horizontal barplot with gap")
}
\keyword{misc}
plotrix/man/jiggle.Rd 0000644 0001762 0000144 00000002141 14011145766 014261 0 ustar ligges users \name{jiggle}
\alias{jiggle}
\title{ Calculate equally spaced values within a range. }
\description{
Calculates a specified number of equally spaced values in a range
}
\usage{
jiggle(n,range=c(-1,1))
}
\arguments{
\item{n}{The number of values to calculate.}
\item{range}{The range within which to fit the values.}
}
\details{
\samp{jiggle} is an alternative to the \samp{jitter} function. Instead
of using \samp{runif} to provide the values, it calls \samp{sample}
and then scales the resulting values to the range specified. This
guarantees that the values will be evenly spaced.
}
\value{ A vector of n values within the range specified. }
\author{Jim Lemon}
\examples{
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")
}
\keyword{misc}
plotrix/man/legendg.Rd 0000755 0001762 0000144 00000006433 14011145766 014440 0 ustar ligges users \name{legendg}
\alias{legendg}
\title{Legend with grouped bars, lines or symbols}
\description{Displays a legend with more than one rectangle, symbol or line.}
\usage{
legendg(x,y=NULL,legend,fill=NULL,col=par("col"),
border=list("black"),lty,lwd,pch=NULL,angle=45,density=NULL,
bty="o",bg=par("bg"),box.lwd=par("lwd"),box.lty=par("lty"),
box.col=par("fg"),pt.bg=NA,cex=1,pt.cex=cex,pt.lwd=lwd,
pt.space=1,xjust=0,yjust=1,x.intersp=1,y.intersp=1,
adj=c(0,0.5),text.width=NULL,text.col=par("col"),merge=FALSE,
trace=FALSE,plot=TRUE,ncol=1,horiz=FALSE,title=NULL,
inset=0,xpd,title.col=text.col)
}
\arguments{
\item{x,y}{Position of the legend as in \samp{legend}.}
\item{legend}{Labels for the legend as in \samp{legend}.}
\item{fill}{List of fill colors for the rectangles.}
\item{col}{Color(s), perhaps as a list, for the symbols.}
\item{border}{Border color(s) for the rectangles.}
\item{lty}{Line type, currently ignored and set to 1.}
\item{lwd}{Line width, currently ignored.}
\item{pch}{List of symbols for the legend.}
\item{angle,density}{Currently ignored.}
\item{bty}{Legend box type to be displayed.}
\item{bg}{Background color for the legend.}
\item{box.lwd,box.lty,box.col}{Line width, type and color
for the surrounding box.}
\item{cex}{Character expansion for text.}
\item{pt.bg,pt.cex,pt.lwd}{Background color, character
expansion and line width for the symbols.}
\item{pt.space}{Spacing for the symbols as a multiplier
for \samp{strwidth("O")}.}
\item{xjust,yjust}{Justification for the legend.}
\item{x.intersp,y.intersp}{x and y character spacing for
the legend text.}
\item{adj}{Text adjustment.}
\item{text.width,text.col}{Width and color of the legend text.}
\item{merge}{Whether to merge points and lines.}
\item{trace}{Show how the legend is calculated.}
\item{plot}{Whether to plot the legend.}
\item{ncol}{Number of columns in the legend.}
\item{horiz}{Whether to display a horizontal legend.}
\item{title}{Title for the legend.}
\item{inset}{Inset distances for use with keywords.}
\item{xpd}{An optional value for \samp{par(xpd=)}.}
\item{title.col}{Color for the legend title.}
}
\value{
The value returned by \samp{legend} returned invisibly.
}
\details{
\samp{legendg} calls \samp{legend} to display a legend with a
blank space to the left of the labels. It then attempts to display
groups of colored rectangles or symbols in that space depending
upon the contents of either \samp{fill} or \samp{pch}. These
should be in the form of a list with the number of elements equal
to the number of labels, and one or more fills or symbols for each
label. \samp{legendg} will display up to four fills or symbols
next to each label, allowing the user to label a group of these
rather than just one per label.
}
\author{Jim Lemon}
\seealso{\link{legend}}
\examples{
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))
# fake a line/point with text points
legendg(0.2,0.25,c("letter","number"),
pch=list(c("-","A","-"),c("-","1","-")),
col=list(rep(2,3),rep(3,3)))
}
\keyword{misc}
plotrix/man/twoord.stackplot.Rd 0000755 0001762 0000144 00000005605 14011145766 016354 0 ustar ligges users \name{twoord.stackplot}
\alias{twoord.stackplot}
\title{Multiple (stack) plot with two ordinates}
\description{
Two set of data are plotted on two different ordinate scales.
}
\usage{
twoord.stackplot(lx, rx, ldata, rdata, lcol, rcol, ltype, rtype,
border, rylab, lylab, xlab, ..., incrylim=NULL,
halfwidth=0.4, leftfront=FALSE, mar = c(5, 4, 4, 4))
}
\arguments{
\item{lx,rx}{x-values for left/right data.}
\item{ldata,rdata}{data on the left/right y-axes.}
\item{lcol, rcol}{colors to be used for left/right data.}
\item{ltype, rtype}{line types to be used for left/right data, see details.}
\item{border}{color for the border of barplot}
\item{rylab,lylab}{labels for the left/right y-axes.}
\item{xlab}{labels for the x-axis.}
\item{...}{further arguments to be passed to \samp{plot}.}
\item{incrylim}{a number to increase the limits of y-axes.}
\item{halfwidth}{half the width of the bars in user units.
The bars are centered on successive integers if no x values are supplied}
\item{leftfront}{if \samp{TRUE}, plot the left data on the front layer.}
\item{mar}{optional margin adjustment, defaults to c(5,4,4,4).}
}
\details{
\samp{twoord.stackplot} works in the same way as \samp{twoord.plot}
on which it is heavily inspired. The functions let the user plot
multiple curve/point or bar plots on the same graph with two different axes.
The line type can be one of the following \samp{"l"} for lines,
\samp{"p"} for points, \samp{"b"} for both points and line,
\samp{"o"} for overplotted, \samp{"bar"} for barplot.
}
\value{ nil }
\seealso{\link{twoord.plot}}
\author{ Christophe Dutang }
\examples{
# plot data
#
time <- 0:25
A <- 1+1/2*sin(time/2)
B <- A + rnorm(length(A), sd=1/10)
B <- B + rnorm(length(A), sd=1/10)
sizeA <- floor(450*(1 + 1/4*sin(time/2+2))*(1+.1))
sizeB <- 1000-sizeA
C <- (A*sizeA + B*sizeB)/(sizeA+sizeB)
#typical usage
#
twoord.stackplot(lx=time, rx=time, ldata=cbind(sizeA, sizeB),
rdata=cbind(A, B, C), lcol=c("grey80", "white"),
rcol=c("blue", "red","black"), ltype="bar", rtype=c("l","p","o"),
border="grey80", lylab="Size", rylab="A,B,C", xlab="Time",
main="a plot", incrylim=2/100)
#add a legend
#
par(xpd=TRUE) #extend the area of plotting
par(new=TRUE) #to add new graph "layers"
plot(0:1, 0:1, type="n", xlab="",ylab="", axes=FALSE) #redo the x/y limits
#first legend
legend(-0.18, 1.2, leg=c("Size A", "Size B"), fill=c("grey80", "white"))
#second legend
legend(.97, -0.08, leg=c("A", "B", "C"), col=c("blue", "red","black"),
pch=c(NA, 19, 19), lty=c(1,NA,1))
par(xpd=FALSE, new=FALSE) #default setting
#reverse the order of plotting
twoord.stackplot(lx=time, rx=time, ldata=cbind(sizeA, sizeB),
rdata=cbind(A, B, C), lcol=c("grey80", "white"),
rcol=c("blue", "red","black"), ltype="bar", rtype=c("l","p","o"),
border="grey80", lylab="Size", rylab="A,B,C", xlab="Time",
main="a plot", incrylim=2/100, leftfront=TRUE)
}
\keyword{misc}
plotrix/man/election.Rd 0000644 0001762 0000144 00000004623 14011145766 014631 0 ustar ligges users \name{election}
\alias{election}
\title{Assign party members to seats}
\description{Create a layout for an election result in an assembly}
\usage{
election(seats,result,formula,colours = sample(rainbow(length(counts))))
}
\arguments{
\item{seats}{A data frame of x and y positions, row numbers and angles
(usually the output from the seats function).}
\item{result}{A data frame with party names and seat counts.}
\item{formula}{A formula with the party name column on the left and the
count column on the right. Think of the twiddle symbol as "got".}
\item{colours}{A vector of colours. If missing a random rainbow is used.
This may cause Green parties to show as red.}
}
\value{
A data frame including:
\item{x}{The x positions of the seats to be plotted on semi-circular
arcs.}
\item{y}{The y positions of the seats to be plotted on semi-circular
arcs.}
\item{r}{The row numbers for each seat.}
\item{theta}{The angle of each seat, going from pi to zero radians.}
\item{party}{The labels for the party holding each seat.}
\item{colour}{The colour that has been assigned to the party.}
}
\author{Barry Rowlingson}
\seealso{\link{seats}}
\examples{
# The EU parliament has 751 seats, and Wikipedia currently shows this
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)
# or using ggplot2
\dontrun{
require(ggplot2)
blank = theme(axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank())
ggplot(eugov, aes(x=x,y=y,col=party)) + geom_point() + coord_fixed() + blank
}
}
\keyword{misc}
plotrix/man/ptext3d.Rd 0000755 0001762 0000144 00000001034 14011145766 014416 0 ustar ligges users \name{ptext3d}
\alias{ptext3d}
\title{ Display text on a 3D plot }
\description{
Display text on a 3D plot defined by a list of coordinates
}
\usage{
ptext3d(x,y=NULL,z=NULL,texts,pmat,...)
}
\arguments{
\item{x,y,z}{ x, y and z coordinates to plot. \samp{x} may be a list with
three components.}
\item{pmat}{ matrix to transform coordinates. }
\item{texts}{ text to display. }
\item{...}{ Other arguments passed to \samp{segments}. }
}
\details{
Draws text on a perspective plot.
}
\value{nil}
\author{Ben Bolker}
\keyword{misc}
plotrix/man/corner.label.Rd 0000755 0001762 0000144 00000002611 14011145766 015373 0 ustar ligges users \name{corner.label}
\alias{corner.label}
\title{Find corner locations and optionally display a label}
\description{
Finds the coordinates in user parameters of a specified corner of the
figure region and optionally displays a label there
}
\usage{
corner.label(label=NULL,x=-1,y=1,xoff=NA,yoff=NA,figcorner=FALSE,...)
}
\arguments{
\item{label}{Text to display. The default is to display nothing.}
\item{x}{an integer value: -1 for the left side of the plot, 1 for the
right side}
\item{y}{an integer value: -1 for the bottom side of the plot, 1 for
the top side}
\item{xoff,yoff}{Horizontal and vertical text offsets. Defaults to one
half of the width and height of "m" respectively. }
\item{figcorner}{Whether to find/display at the corner of the plot or figure.}
\item{...}{further arguments to the \samp{text} command for the label}
}
\details{
\samp{corner.label} finds the specified corner of the plot or figure and if
\samp{label} is not NULL, displays it there. The text justification is specified
so that the label will be justified away from the corner. To get the label
squeezed right into a corner, set \samp{xoff} and \samp{yoff} to zero.
}
\value{
A list of the x and y positions of the corner adjusted for the offsets.
}
\author{Ben Bolker}
\examples{
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")
}
\keyword{aplot}
plotrix/man/drawNestedBars.Rd 0000755 0001762 0000144 00000003702 14011145766 015737 0 ustar ligges users \name{drawNestedBars}
\alias{drawNestedBars}
\title{Display nested bars}
\description{Displays the nested bars for barNest.}
\usage{
drawNestedBars(x,start,end,shrink=0.1,errbars=FALSE,intervals=TRUE,col=NA,
labelcex=1,lineht=NULL,showall=TRUE,Nwidths=FALSE,barlabels=NULL,
showlabels=TRUE,arrow.cap=NA)
}
\arguments{
\item{x}{One level of the breakdown produced by \samp{brkdnNest}.}
\item{start,end}{The left and right x coordinates for the bar or group of bars
to be displayed.}
\item{shrink}{The proportion to shrink the width of the bars at each level.}
\item{errbars}{Whether to display error bars on the bars.}
\item{intervals}{Whether to use offsets or absolute values when displaying
measures of dispersion.}
\item{col}{The colors to use to fill the bars. See Details.}
\item{labelcex}{Character size for the group labels.}
\item{lineht}{The height of a margin line in user units.}
\item{showall}{Whether to display the bars at any levels above the last.}
\item{Nwidths}{Whether to scale the widths of the bars to the number of
observations.}
\item{barlabels}{Optional labels to display below the bars.}
\item{showlabels}{Whether to display the labels below the bars.}
\item{arrow.cap}{The width of the "cap" on error bars in user units,
defaulting to 0.01 of the width of the plot.}
}
\value{nil}
\details{
\samp{drawNestedBars} displays the bars for the nested breakdown performed
by \samp{brkdnNest}. It starts at the top of the list and calls itself for
each level of the breakdown. It is unlikely to be useful for anything else.
The combination of \samp{showlabels=TRUE} and \samp{showall=FALSE} allows
the display of all of the labels below the plot with only the last set of
bars being displayed. To have a set of labels not displayed, pass explicit
\samp{barlabels} and have zero length labels for the level that is not to
have labels.
}
\author{Jim Lemon and Ofir Levy}
\seealso{\link{brkdnNest}, \link{drawNestedBars}}
\keyword{misc}
plotrix/man/p2p_arrows.Rd 0000644 0001762 0000144 00000001437 14011145766 015125 0 ustar ligges users \name{p2p_arrows}
\alias{p2p_arrows}
\title{Draw arrows between points}
\description{Displays arrows on an existing plot between specified
points.}
\usage{
p2p_arrows(x1,y1,x2,y2,space=0.05,col=par("fg"),...)
}
\arguments{
\item{x1}{Starting x positions for the labels.}
\item{y1}{Starting y positions for the labels.}
\item{x2}{Ending x positions for the labels.}
\item{y2}{Ending y positions for the labels.}
\item{space}{The proportion of the distance between the points to
leave as space before and after the arrow.}
\item{col}{Color(s) for the arrows.}
\item{...}{Extra arguments passed to \samp{arrows}.}
}
\details{
\samp{p2p_arrows} displays arrows on a plot between one or more pairs
of specified points.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{arrows}}
\keyword{misc}
plotrix/man/color.scale.Rd 0000755 0001762 0000144 00000012766 14011145766 015245 0 ustar ligges users \name{color.scale}
\alias{color.scale}
\title{Turn values into colors.}
\description{Transform numeric values into colors using RGB, HSV or HCL}
\usage{
color.scale(x,cs1=c(0,1),cs2=c(0,1),cs3=c(0,1),alpha=1,
extremes=NA,na.color=NA,xrange=NULL,color.spec="rgb")
}
\arguments{
\item{x}{a numeric vector, matrix or data frame}
\item{cs1,cs2,cs3}{color parameters for scaling \samp{x}}
\item{alpha}{Value for transparency in colors. If more than one value is
passed, the alpha values will be transformed like the colors.}
\item{extremes}{The colors for the extreme values of \samp{x} (RGB only).}
\item{na.color}{The color to use for NA values of \samp{x}.}
\item{xrange}{An explicit range to use in the transformation.}
\item{color.spec}{The color specification to use in the transformation.
Anything other than "rgb", "hsv" or "hcl" will almost certainly fail.}
}
\details{
\samp{color.scale} calculates a sequence of colors by a linear
transformation of the numeric values supplied into the ranges
for the three color parameters. If only one number is supplied for a
color range, that color remains constant for all values of \samp{x}.
If more than two values are supplied, the \samp{x} values will be
split into equal ranges (one less than the number of colors) and
the transformation carried out on each range. Values for a color
range must be between 0 and 1 for the RGB or HSV specifications, and
between 0 and 360 (cs1) and 0 to 100 (cs2 and cs3) for the HCL
specifications.
IMPORTANT: If \samp{x} has fewer values than the number of values
in the color parameters, it will usually return incorrect
colors. This is usually only a problem when using \samp{color.legend}
with a small number of rectangles in the legend as \samp{color.legend}
calls \samp{color.scale} to calculate the color rectangles.
If \samp{extremes} is not NA, the ranges will be calculated from
its values using \samp{col2rgb}, even if ranges are also supplied.
\samp{extremes} allows the user to just pass the extreme color values
in any format that \samp{col2rgb} will accept. Note that this forces
the color specification to RGB.
If the user wants to specify a range of values with \samp{xrange},
it must at least include the range of x values. This can be useful
when there is a notional range like 0-100\% that the values do not
cover, or when several series of values with different ranges are
to be assigned the same color scale.
The user may not want the color scheme to be continuous across some
critical point, often zero. In this case, \samp{color.scale} can be called
separately for the values below and above zero. I may get around to
adding an argument to do this in one shot. Until then, see the second
example for \samp{color2D.matplot} and also the \samp{diverge.hcl} and
\samp{diverge.hsv} functions in the \pkg{colorspace} package.
When passing more than one alpha value, it will be transformed like the
colors. This allows matrices with concentrations of high values to be
overplotted to illustrate group locations and separations. See the iris
example in \samp{color2D.matplot}.
}
\note{
The function is useful for highlighting a numeric dimension or adding
an extra "dimension" to a plot.
There are quite a few R functions that transform numeric values into
colors or produce colors that can be used to represent values. Two
packages that might be of interest are \pkg{RColorBrewer} and
\pkg{colourschemes}. See the last example for approximating other color
scales with \samp{color.scale}.
}
\value{A vector or matrix of hexadecimal color values.}
\author{Jim Lemon}
\seealso{\link{rescale}, \link{col2rgb}, \link{smoothColors}}
\examples{
# go from green through yellow to red with no blue
x<-rnorm(20)
y<-rnorm(20)
# use y for the color scale
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"))
\dontrun{
# requires viridisLite
library(viridisLite)
plot(0,xlim=c(-1,1),ylim=c(-1,1),type="n",axes=FALSE,
main="Approximating other color scales",xlab="",ylab="")
gradient.rect(-1,0.8,1,0.95,nslices=50,
col=color.scale(1:50,1,
c(0,0.3,0.6,0.8,1,1),
c(0,0,0,0,0,0,1)))
text(0,1,"color.scale")
gradient.rect(-1,0.65,1,0.8,col=heat.colors(50))
text(0,0.6,"heat.colors")
gradient.rect(-1,0.3,1,0.45,nslices=50,
col=color.scale(1:50,c(0,0.2,0.9,0.95,0.95),
c(0.7,0.8,0.9,0.7,0.95),
c(0.1,0,0,0.35,0.95)))
text(0,0.5,"color.scale")
gradient.rect(-1,0.15,1,0.3,col=terrain.colors(50))
text(0,0.1,"terrain.colors")
gradient.rect(-1,-0.2,1,-0.05,nslices=50,
col=color.scale(1:50,c(0.3,0,0.3,0.1,1,0.95,1),
c(0,0.3,0.9,1,1,0.85,0.85),
c(1,1,0.9,0.1,0,0.5,0.5)))
text(0,0,"color.scale")
gradient.rect(-1,-0.35,1,-0.2,col=topo.colors(50))
text(0,-0.4,"topo.colors")
gradient.rect(-1,-0.7,1,-0.55,nslices=50,
col=color.scale(1:50,c(0.3,0.2,0,0.4,0.95),
c(0.1,0.3,0.6,0.75,0.95),
c(0.3,0.6,0.5,0.4,0)))
text(0,-0.5,"color.scale")
gradient.rect(-1,-0.85,1,-0.7,col=viridis(50))
text(0,-0.9,"viridis")
}
}
\keyword{misc}
plotrix/man/densityGrid.Rd 0000644 0001762 0000144 00000011454 14011145766 015314 0 ustar ligges users \name{densityGrid}
\alias{densityGrid}
\title{Display a matrix of cell values as symbols.}
\description{
Displays a matrix of values as symbols on an existing image.
}
\usage{
densityGrid(x,z=NULL,xrange=NA,zrange=NA,range.cex=c(1,10),
xlim=c(-180,180),ylim=c(-90,90),red=c(0,1),green=c(0,1),blue=c(0,1),alpha=1,
pch=".",geocoord=TRUE)
}
\arguments{
\item{x}{Matrix of values representing counts in cells (usually locations).}
\item{z}{Optional matrix of values attached to the cells in x.}
\item{xrange,zrange}{Explicit ranges for the counts in x and z. Used to
define a "pretty" set of values to label legends.}
\item{range.cex}{The range of expansion for the symbols when this is used to
indicate the number of counts in the cells.}
\item{xlim}{The extreme coordinates in the horizontal direction (see Details).}
\item{ylim}{The extreme coordinates in the vertical direction (see Details).}
\item{red,green,blue}{Values in an RGB colorspace to use in transforming the
cell values into colors.}
\item{alpha}{Transparency of the colors.}
\item{pch}{The symbol to use in displaying the observation density. Either
"." or 15 seem to work well depending upon the resolution of the grid.}
\item{geocoord}{Whether the size of the symbols that indicate density when
there are intensity values should be corrected for a Mercator projection.}
}
\details{
\samp{densityGrid} expects one matrix or a list of two matrices containing
values that will be transformed into colors or sizes of the symbols displayed.
The two matrices may be passed as a list. If only one matrix is present, the
color of the symbols is determined by the values (counts) in the matrix. If
a second matrix is passed, The values in that matrix will be used to determine
the colors, and the size of the symbols will be proportional to the values in
the first matrix. In the case of only one matrix, the user should set the
first value of \samp{range.cex} to the desired expansion of the symbols.
Currently \samp{densityGrid} does not display anything in grid cells that have
zero count values.
\samp{densityGrid} was developed to allow very large numbers of coordinate
locations to be accumulated in a matrix for display on a geographic map. Thus
the default limits refer to coordinates as latitude/longitude for the earth.
Because some geographic data are so numerous that memory limits are exceeded,
the underlying \samp{makeDensityMatrix} function can be run on small sections
of the entire data set and the resulting matrices added as long as the initial
coordinate limits are used throughout. Note that if the values for counts
(with one matrix) or for intensity (with two matrices) cover a very large
range, it may be necessary to trim extreme values (noting this on any legends)
and transform the data (usually log10) to get good color separation.
}
\value{
nil. Displays a grid of symbols on an existing plot device.
}
\examples{
\dontrun{
data(l2010)
# log10 transform both density and intensity
l2010[[1]]<-log10(l2010[[1]])
l2010[[2]]<-log10(l2010[[2]])
library(maps)
x11(width=10)
par(mar=c(7,3,2,3))
plot(0,xlim=c(-180,180),ylim=c(-90,90),type="n",axes=FALSE,xlab="",ylab="")
densityGrid(l2010,pch=".",xrange=c(0,6),zrange=c(2,8),range.cex=c(2,8),
red=c(0,0.5,1),green=c(0,1,0),blue=c(1,0,0),alpha=1)
color.legend(-60,-107,60,-97,c("2","3","4","5","6","7","8"),
rect.col=color.scale(1:7,cs1=c(0,0.5,1),cs2=c(0,1,0),cs3=c(1,0,0),alpha=1),
cex=0.5)
par(xpd=TRUE)
text(0,95,"Lightning strikes 2010")
text(0,-114,"Mean intensity kVA (10^n)",cex=0.5)
points(x=seq(-60,60,20),y=rep(-125,7),pch=".",cex=1:7)
text(x=seq(-60,60,20),y=rep(-132,7),c("<=1","2","3","4","5","6",">6"),cex=0.5)
text(0,-142,"Cell frequency (10^n)",cex=0.5)
par(xpd=FALSE)
map("world",mar=c(7,3,2,3),add=TRUE)
dev.off()
# now only Australia
par(mar=c(7,3,2,3))
plot(0,xlim=c(112,154),ylim=c(-43.8,-11.1),type="n",axes=FALSE,xlab="",ylab="")
densityGrid(l2010,pch=".",xrange=c(0,6),zrange=c(2,8),range.cex=c(2,8),
xlim=c(112,154),ylim=c(-43.8,-11.1),red=c(0,0.5,1),green=c(0,1,0),
blue=c(1,0,0),alpha=1)
color.legend(120,-47,146,-45,c("2","3","4","5","6","7","8"),
rect.col=color.scale(1:7,cs1=c(0,0.5,1),cs2=c(0,1,0),cs3=c(1,0,0),alpha=1),
cex=0.5)
par(xpd=TRUE)
text(133,-9,"Lightning strikes 2010 (Australia)")
text(133,-48.2,"Mean intensity kVA (10^n)",cex=0.5)
points(x=seq(121,145,4),y=rep(-50,7),pch=".",cex=1:7)
text(x=seq(121,145,4),y=rep(-51,7),c("<=1","2","3","4","5","6",">6"),cex=0.5)
text(133,-52,"Cell frequency (10^n)",cex=0.5)
par(xpd=FALSE)
map("world",mar=c(7,3,2,3),xlim=c(112,154),ylim=c(-43.8,-11.1),add=TRUE)
}
}
\author{Jim Lemon}
\seealso{\link{makeDensityMatrix},\link{color.scale}}
\keyword{misc}
plotrix/man/dispersion.Rd 0000755 0001762 0000144 00000007242 14011145766 015211 0 ustar ligges users \name{dispersion}
\alias{dispersion}
\alias{dispbars}
\title{ Display a measure of dispersion. }
\description{
Display lines or capped bars at specified points on a plot representing
measures of dispersion.
}
\usage{
dispersion(x,y,ulim,llim=ulim,intervals=TRUE,arrow.cap=0.01,arrow.gap=NA,
type="a",fill=NA,lty=NA,pch=NA,border=NA,col=par("fg"),display.na=TRUE,
...)
}
\arguments{
\item{x,y}{x and y position of the centers of the bars}
\item{ulim,llim}{The extent of the dispersion measures.}
\item{arrow.cap}{The width of the cap at the outer end of each bar
as a proportion of the width of the plot.}
\item{arrow.gap}{The gap to leave at the inner end of each bar.
Defaults to two thirds of the height of a capital "O".}
\item{intervals}{Whether the limits are intervals (TRUE) or absolute values
(FALSE).}
\item{type}{What type of display to use.}
\item{fill}{Color to fill between the lines if \samp{type} is not NULL and
\samp{fill} is not NA.}
\item{lty}{Line type for redrawing the lines if necessary.}
\item{pch}{Symbol for redrawing the points if necessary.}
\item{border}{Line type for drawing a border on the confidence band.}
\item{col}{Color for the lines or capped bars.}
\item{display.na}{Whether to display NA values as lines going off the plot.}
\item{...}{additional arguments passed to \samp{arrows} or \samp{lines}
depending upon \samp{type}.}
}
\details{
\samp{dispersion} displays a measure of dispersion on an existing plot.
Currently it will display either vertical lines with caps (error bars) or lines
that form a "confidence band" around a line of central tendency. If \samp{fill}
is not NA and \samp{type} is \samp{"l"}, a polygon will be drawn between the
confidence lines. Remember that any points or lines within the confidence band
will be obscured, so pass point and/or line types as in the second example.
The default behavior is to display an undefined dispersion (e.g. a variance with
only one observation) as a line going off the plot. If \samp{display.na} is FALSE,
NA values will not be displayed, allowing the user to show only upper or lower
dispersion limits.
The \samp{intervals} argument allows the user to pass the limits as either
intervals (the default) or absolute values.
If \samp{arrow.gap} is greater than or equal to the upper or lower
limit for a bar, \samp{segments} is used to draw the upper and
lower caps with no bars to avoid zero length arrows.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{arrows}, \link{segments},\link{lines}}
\examples{
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])
plot(disptest.means[row.order],main="Dispersion as confidence band",
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],type="l",
fill="#eeccee",lty=2,pch=1)
disptest2<-matrix(sample(c(TRUE,FALSE),200,TRUE),nrow=10)
disptest.prop<-rowMeans(disptest2)
disptest.ulim<-disptest.llim<-rep(NA,10)
for(i in 1:10) {
disptest.ulim[i]<-binciWu(disptest2[i,],20)
disptest.llim[i]<-binciWl(disptest2[i,],20)
}
plot(disptest.prop,main="Dispersion as binomial confidence intervals",
ylim=c(min(disptest.llim),max(disptest.ulim)),
xlab="Sample",ylab="Proportion")
dispersion(1:10,disptest.prop,disptest.ulim,disptest.llim,
interval=FALSE,lty=2,pch=1)
}
\keyword{misc}
plotrix/man/weighted.hist.Rd 0000755 0001762 0000144 00000004107 14011145766 015575 0 ustar ligges users \name{weighted.hist}
\alias{weighted.hist}
\title{
Display a weighted histogram
}
\description{
Calculate the counts of the weighted values in specified bins and
optionally display either a frequency or density histogram.
}
\usage{
weighted.hist(x,w,breaks="Sturges",col=NULL,plot=TRUE,
freq=TRUE,ylim=NA,ylab=NULL,xaxis=TRUE,...)
}
\arguments{
\item{x}{A vector of numeric values}
\item{w}{A vector of weights at least as long as x.}
\item{breaks}{The endpoints of the ranges into which to count the weighted
values.}
\item{col}{An optional vector of colors for the bars of the histogram.}
\item{plot}{Whether to plot a histogram.}
\item{freq}{Whether to plot counts or densities.}
\item{ylim}{The limits of the plot ordinate.}
\item{ylab}{Label for the ordinate.}
\item{xaxis}{Whether to display an X axis.}
\item{...}{additional arguments passed to \samp{barplot}.}
}
\details{
\samp{weighted.hist} calculates the weighted counts of values falling
into the ranges specified by \samp{breaks}. Instead of counting each
value as 1, it counts the corresponding value in \samp{w} (the weight).
\samp{breaks} may be specified by a monotonically increasing vector
of numbers that are interpreted as the endpoints of the ranges, a
single number representing the number of ranges desired or the name
of the function to calculate the ranges (see \link{hist}).
If a vector of numbers is passed that does not include all values in
\samp{x}, the user is warned.
}
\value{A list containing:
breaks - The endpoints of the intervals
counts - The weighted counts
density - The weighted counts divided by their sum.
mids - The midpoints of the intervals and the bars displayed.
xname - the name of \samp{x}.
}
\author{Jim Lemon and Hadley Wickham - thanks to Ben Graf for asking for a
custom x axis option and Martin Maechler for fixing the barplot problem}
\seealso{\link{hist}}
\examples{
testx<-sample(1:10,300,TRUE)
testw<-seq(1,4,by=0.01)
weighted.hist(testx,testw,breaks=1:10,main="Test weighted histogram")
}
\keyword{misc}
plotrix/man/gap_barp.Rd 0000644 0001762 0000144 00000003650 14011145766 014601 0 ustar ligges users \name{gap_barp}
\alias{gap_barp}
\title{
Display a barplot with a gap (missing range) on one axis
}
\description{
Displays a barplot with a missing range.
}
\usage{
gap_barp(height,gap,width=0.4,names.arg=names(height),
col=NULL,main="",xlab="",ylab="",xlim=NULL,ylim=NULL,x=NULL,
height.at=pretty(height),height.lab=NULL,...)
}
\arguments{
\item{height}{a vector of data values}
\item{gap}{the range of values to be left out}
\item{width}{the proportion of bar width to bar spacing divided by 2.
width=1 means no spaces between the bars.}
\item{names.arg}{labels for the bars.}
\item{col}{color(s) in which to plot the values}
\item{main}{title for the plot.}
\item{xlab}{label for the x axis}
\item{ylab}{label for the y axis}
\item{xlim}{Optional x limits for the plot}
\item{ylim}{optional y limits for the plot}
\item{x}{optional x positions for the bars.}
\item{height.at}{explicit positions for the y axis ticks}
\item{height.lab}{explicit labels for the y axis ticks.}
\item{...}{arguments passed to \samp{barp}.}
}
\value{
The center positions of the bars.
}
\details{
Displays a barplot omitting a range of values on the X or Y axis. Typically
used when there is a relatively large gap in the range of values
represented as bar heights. See \link{axis.break} for a brief
discussion of plotting on discontinuous coordinates.
If the user does not ask for specific y limits, the function will calculate
limits based on the range of the data values. If passing specific limits,
remember to subtract the gap from the upper or lower limit.
}
\author{Jim Lemon}
\seealso{\link{barp}}
\examples{
oneout<-c(rnorm(5,sd=5),20,rnorm(5,sd=5))
gap_barp(oneout,gap=c(8,16),xlab="Index",height.at=c(-5,0,5,20),
ylab="Group values",main="Barplot with gap above zero")
oneout[6]<--20
gap_barp(oneout,gap=c(-8,-16),xlab="Index",height.at=c(-20,-5,0,5),
ylab="Group values",main="Barplot with gap below zero")
}
\keyword{misc}
plotrix/man/plot_bg.Rd 0000644 0001762 0000144 00000001000 14011145766 014437 0 ustar ligges users \name{plot_bg}
\alias{plot_bg}
\title{ Add a background color to a plot }
\description{Displays a colored rectangle over the entire area of a plot}
\usage{plot_bg(col="lightgray")}
\arguments{
\item{col}{The color of the background}
}
\details{
\samp{plot_bg} is probably only useful when part of the \samp{do.first}
argument in another plot function to add a background color to the plot.
}
\value{nil}
\author{Jim Lemon}
\examples{
barp(1:5,do.first="plot_bg()",col=1:5)
}
\keyword{misc}
plotrix/man/multhist.Rd 0000755 0001762 0000144 00000002771 14011145766 014705 0 ustar ligges users \name{multhist}
\alias{multhist}
\title{Plot a multiple histogram, as a barplot}
\description{
Given a list, plots a side-by-side barplot containing the histograms
of the elements
}
\usage{
multhist(x,beside=TRUE,freq=NULL,probability=!freq,plot.it=TRUE,...)
}
\arguments{
\item{x}{a list of numeric vectors}
\item{beside}{plot histogram bars for groups side-by-side?}
\item{freq}{logical; if 'TRUE', the histogram graphic is a representation
of frequencies, the 'counts' component of the result; if
'FALSE', probability densities, component 'density', are
plotted (so that the histogram has a total area of one).
Defaults to 'TRUE' if 'probability' is not specified
(does not consider equidistant breaks as in \link{hist})}
\item{probability}{an alias for '!freq', for S compatibility}
\item{plot.it}{Whether or not to display the histogram.}
\item{...}{additional arguments to \link{hist} or \link{barplot}}
}
\value{
A list including the return value for the first call to \samp{hist} (itself a list)
and the values for the bar heights.
}
\author{Ben Bolker}
\seealso{\link{hist},\link{barplot}}
\note{
The 'inside' argument to \link{barplot} (which is not currently
implemented in barplot anyway) is deleted from the argument list. The
default value of NULL for \samp{freq} is for consistency with \samp{hist}
but is equivalent to TRUE.
}
\examples{
set.seed(1234)
l <- list(runif(10)*10,1:10,c(1,1,1,1,4,8))
multhist(l)
}
\keyword{hplot}
plotrix/man/getIntersectList.Rd 0000755 0001762 0000144 00000004025 14011145766 016322 0 ustar ligges users \name{getIntersectList}
\alias{getIntersectList}
\title{Enter a set intersection list}
\description{Enter the information for a set intersection display.}
\usage{
getIntersectList(nelem,xnames=NULL,sep="+")
}
\arguments{
\item{nelem}{The number of sets for which the intersections will be displayed.}
\item{xnames}{The labels for the set intersections. The function creates names
from combinations of the first \samp{nelem} capital letters if none are
given.}
\item{sep}{The separator to use when calling \samp{paste}.}
}
\details{
\samp{getIntersectList} allows the user to manually enter the counts of
set intersections rather than build this information from a matrix of data.
It is probably most useful for producing an intersection diagram when the
counts of the intersections are already known, or when the values are
proportions rather than counts as in the example.
It is very helpful when there are large numbers of elements, as the
\samp{makeIntersectList} function runs very slowly.
}
\value{A list of the counts of elements in the set intersections.}
\author{Jim Lemon}
\seealso{\link{makeIntersectList}, \link{intersectDiagram}}
\examples{
# this example is from a haplotype mapping problem submitted by Mao Jianfeng
\dontrun{
hapIntList<-
getIntersectList(3,xnames=c("hap.Pd","hap.Pt","hap.Py"))
# enter the data as follows:
# Number of elements in hap.Pd - 1: 27.586
# Number of elements in hap.Pt - 1: 20.689
# Number of elements in hap.Py - 1: 31.035
# Number of elements in hap.Pd-hap.Pt - 1: 10.345
# Number of elements in hap.Pd-hap.Py - 1: 10.345
# Number of elements in hap.Pt-hap.Py - 1: 0
# Number of elements in hap.Pd-hap.Pt-hap.Py - 1: 0
# Total number of elements - 1: 100
}
hapIntList<-structure(list(structure(c(27.586, 20.689, 31.035),
.Names = c("hap.Pd","hap.Pt","hap.Py")),
structure(c(10.345, 10.345, 0),
.Names = c("hap.Pd-hap.Pt","hap.Pd-hap.Py","hap.Pt-hap.Py")),
structure(0, .Names = "hap.Pd-hap.Pt-hap.Py"),100),
class = "intersectList")
intersectDiagram(hapIntList)
}
\keyword{misc}
plotrix/man/panes.Rd 0000755 0001762 0000144 00000005600 14011145766 014134 0 ustar ligges users \name{panes}
\alias{panes}
\title{Prepare a "panel" type layout}
\description{
Split the graphics device into a "panel" type layout for a group of plots
}
\usage{
panes(mat=NULL,widths=rep(1,ncol(mat)),heights=rep(1,nrow(mat)),
nrow=2,ncol=2,mar=c(0,0,1.6,0),oma=c(2.5,1,1,1))
}
\arguments{
\item{mat}{A matrix representing the number of panes to be created and
their order of plotting.}
\item{widths,heights}{The widths and heights of the panes.
See \samp{layout}.}
\item{nrow,ncol}{The numbers of rows and columns in the layout.
See \samp{par(mfrow)}.}
\item{mar}{The margins for each plot in the panes.}
\item{oma}{The outer margins for the entire group of panes.}
}
\details{
\samp{panes} combines the information for displaying a set of plots in
a "panel" layout. The default values will usually produce the desired
result by calling \samp{par(mfrow)}. If \samp{mat} is not NULL, the
\samp{layout} function will be called instead of \samp{par(mfrow)}.
The two methods are included for the convenience of the user.
Note that \samp{panes} does not produce any plots and that the user
must call \samp{tab.title} to get the "look" of the panel plot. The
overall title is usually centered at the left edge (as in the example)
or in the center of one of the plots in the bottom row.
}
\value{
The values of \samp{par} options that existed when \samp{panes} was
called. This list is usually used to restore those values.
}
\author{Jim Lemon}
\seealso{\link{par},\link{layout}}
\examples{
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)
panes(matrix(1:3,ncol=1),heights=c(0.7,0.8,1))
par(mar=c(0,2,2,2))
plot(sort(runif(7)),type="l",axes=FALSE)
axis(2,at=seq(0.1,0.9,by=0.2))
box()
tab.title("Rising expectations",tab.col="#ee6666")
barplot(rev(sort(runif(7))),col="blue",axes=FALSE)
axis(2,at=seq(0.1,0.9,by=0.2))
box()
tab.title("Diminishing returns",tab.col="#6666ee")
par(mar=c(4,2,2,2))
tso<-c(0.2,0.3,0.5,0.4,0.6,0.8,0.1)
plot(tso,type="n",axes=FALSE,xlab="")
# the following needs a Unicode locale to work
points(1:7,tso,pch=c(rep(-0x263a,6),-0x2639),cex=2)
axis(1,at=1:7,
labels=c("Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday","Monday"))
axis(2,at=seq(0.1,0.9,by=0.2))
box()
tab.title("The sad outcome",tab.col="#66ee66")
mtext("A lot of malarkey",side=1,line=2.5)
par(oldpar)
}
\keyword{misc}
plotrix/man/soil.texture.Rd 0000755 0001762 0000144 00000007424 14011145766 015501 0 ustar ligges users \name{soil.texture}
\alias{soil.texture}
\title{Soil texture triangle plot}
\description{
Display a USDA soil texture triangle with optional grid, labels and
soil texture points.
}
\usage{
soil.texture(soiltexture=NULL, main="", at=seq(0.1, 0.9, by=0.1),
axis.labels=c("percent sand", "percent silt",
"percent clay"),
tick.labels=list(l=seq(10, 90, by=10), r=seq(10, 90, by=10),
b=seq(10, 90, by=10)),
show.names=TRUE, show.lines=TRUE, col.names="gray",
bg.names=par("bg"), show.grid=FALSE, col.axis="black",
col.lines="gray", col.grid="gray", lty.grid=3,
show.legend=FALSE, label.points=FALSE, point.labels=NULL,
col.symbols="black", pch=par("pch"), \dots)
}
\arguments{
\item{soiltexture}{Matrix of soil textures where each row is a
soil sample and three columns contain the proportions of the
components sand, silt and clay in the range 0 to 1 or
percentages in the range 0 to 100.}
\item{main}{The title of the soil texture plot. Defaults to nothing.}
\item{at}{Positions on the three axes where ticks will be drawn.}
\item{axis.labels}{Labels for the axes.}
\item{tick.labels}{The tick labels for the three axes.}
\item{show.names}{Logical - whether to show the names of different
soil types within the soil triangle.}
\item{show.lines}{Logical - whether to show the boundaries of the
different soil types within the soil triangle.}
\item{col.names}{Color of the soil names. Defaults to gray.}
\item{bg.names}{Color to use when drawing a blank patch for the names
of soil types.}
\item{show.grid}{Logical - whether to show grid lines at each 10%
level of each soil component.}
\item{col.axis}{Color of the triangular axes, ticks and labels.}
\item{col.lines}{Color of the boundary lines. Defaults to gray.}
\item{col.grid}{Color of the grid lines. Defaults to gray.}
\item{lty.grid}{Type of line for the grid. Defaults to dashed.}
\item{show.legend}{Logical - whether to display a legend.}
\item{label.points}{Logical - whether to call
\link{thigmophobe.labels} to label the points.}
\item{point.labels}{Optional labels for the points or legend.}
\item{col.symbols}{Color of the symbols representing each value.}
\item{pch}{Symbols to use in plotting values.}
\item{\dots}{Additional arguments passed to \link{triax.points}
and then \samp{points}.}
}
\details{
\samp{soil.texture} displays a triangular plot area on which soil
textures defined as proportions of sand, silt and clay can be plotted.
Optional grid, vertex labels, soil type divisions and names may also
be displayed. If a matrix of soil textures is present, these will be
plotted.
}
\value{If \samp{soiltexture} was included, a list of the \samp{x,y}
positions of the soil types plotted. If not, nil.
}
\note{This is now a special case of \samp{triax.plot}.}
\author{Sander Oom, Jim Lemon, and Michael Toews}
\references{
U.S. Department of Agriculture, Natural Resources Conservation Service,
2007. \emph{National Soil Survey Handbook}, title 430-VI.//
\url{https://www.nrcs.usda.gov/wps/portal/nrcs/detail/soils/survey/class/taxonomy/?cid=nrcs142p2_053577}
U.S. Department of Agriculture, Natural Resources Conservation Service,
2007. \emph{Soil Texture Calculator}//
\url{https://www.nrcs.usda.gov/wps/portal/nrcs/detail/soils/survey/class/taxonomy/?cid=nrcs142p2_053577}
}
\seealso{\link{get.soil.texture}, \link{triax.plot}}
\examples{
data(soils)
soil.texture(main="NO DATA")
soil.texture(soils, main="DEFAULT", pch=2)
soil.texture(soils, main="LINES AND NAMES", show.lines=TRUE,
show.names=TRUE, pch=3)
soiltex.return<-soil.texture(soils[1:6,], main="GRID AND LEGEND",
show.grid=TRUE, pch=4, col.symbols=1:6, show.legend=TRUE)
par(soiltex.return$oldpar)
}
\keyword{misc}
plotrix/man/gap.boxplot.Rd 0000755 0001762 0000144 00000006707 14114535655 015300 0 ustar ligges users \name{gap.boxplot}
\alias{gap.boxplot}
\title{Display a boxplot with a gap (missing range)}
\description{
Displays a boxplot with a missing range.
}
\usage{
gap.boxplot(x,...,gap=list(top=c(NA,NA),bottom=c(NA,NA)),
range=1.5,width=NULL,varwidth=FALSE,notch=FALSE,outline=TRUE,
names,xlim=NA,ylim=NA,plot=TRUE,border=par("fg"),col=NULL,log="",
axis.labels=NULL,axes=TRUE,pars=list(boxwex=0.8,staplewex=0.5,outwex=0.5),
horizontal=FALSE,add=FALSE,at=NULL,main=NULL,xlab="",ylab="")
}
\arguments{
\item{x}{numeric vector or a list of vectors}
\item{...}{arguments passed to \link{boxplot}.}
\item{gap}{the range(s) to be omitted - a list with two components,
\samp{top} and \samp{bottom} each specifying a range to omit. The
default range of \samp{c(NA,NA)} means no omitted range}
\item{range}{how far to extend the whiskers, (see \link{boxplot})}
\item{width}{the relative widths of the boxes}
\item{varwidth}{if TRUE, box widths are proportional to the square roots
of the number of observations}
\item{notch}{whether to display the confidence intervals for the
median as notches}
\item{outline}{whether to display outliers}
\item{names}{optional names to display beneath each boxplot}
\item{xlim,ylim}{Optional x and y axis limits for the plot.}
\item{boxwex}{scale factor for box widths}
\item{staplewex}{staple width proportional to box width}
\item{outwex}{outlier line width}
\item{plot}{dummy argument for consistency with \samp{boxplot} - always
plots}
\item{border}{optional color(s) for the box lines}
\item{col}{optional color(s) to fill the boxes}
\item{log}{whether to use a log scale - currently does nothing}
\item{axis.labels}{Optional axis labels.}
\item{axes}{Whether to display axes.}
\item{pars}{optional parameters for consistency with \samp{boxplot}}
\item{horizontal}{whether to plot horizontal boxplots - currently
does nothing}
\item{add}{whether to add the boxplot(s) to an existing plot - currently
does nothing.}
\item{at}{optional horizontal locations for the boxplots.}
\item{main}{a title for the plot.}
\item{xlab,ylab}{X and Y axis labels.}
}
\value{
A list with the same structure as returned by \samp{boxplot}, except that
the values of elements beyond the gap(s) have their true positions on the
plot rather than the original values. For example, in the second example,
the value returned for the upper staple of the right boxplot is 14 rather
than 20, due to the 6 unit gap.
}
\details{
Displays boxplot(s) omitting range(s) of values on the top and/or bottom
of the plot. Typically used when there are outliers far from the boxes.
See \link{boxplot} for more detailed descriptions of the
arguments. If the gaps specified include any of the values in the \samp{stats}
matrix returned from \samp{boxplot}, the function will exit with an
error message. This prevents generation of NAs in indexing operations,
which would fail anyway. A gap can include part of a box, but it is unlikely
that this would be intended by the user.
See \link{axis.break} for a brief discussion
of plotting on discontinuous coordinates.
}
\author{Jim Lemon}
\seealso{\link{gap.barplot},\link{gap.plot}}
\examples{
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="Show outliers separately")
if(dev.interactive()) par(ask=TRUE)
gap.boxplot(twovec,gap=list(top=c(12,18),bottom=c(-5,-3)),range=0,
main="Include outliers in whiskers")
par(ask=FALSE)
}
\keyword{misc}
plotrix/man/placeLabels.Rd 0000644 0001762 0000144 00000003711 14011145766 015233 0 ustar ligges users \name{placeLabels}
\alias{placeLabels}
\title{ Place labels in boxes }
\description{
Places labels in boxes on an existing plot
}
\usage{
placeLabels(x,y=NA,labels,pointer=TRUE,cex=1,labelcol=par("fg"),
labelbg="white",border=par("fg"),pointercol=par("fg"),
pch=1,col=1,bg="white",flagcol="red")
}
\arguments{
\item{x,y}{x and y position of the centers of the labels. \samp{x} can be an
\link{xy.coords} list.}
\item{labels}{Text strings}
\item{pointer}{Whether to draw a line segment from the label to the
points labeled.}
\item{cex}{Character expansion. See \samp{text}.}
\item{labelcol}{The color(s) of the text in the labels.}
\item{labelbg}{The background color(s) for the labels.}
\item{border}{The color(s) for the borders around the rectangles.}
\item{pointercol}{The color(s) of the pointer lines.}
\item{pch}{The symbol(s) to use when redisplaying the original points
(see Details).}
\item{col}{The color(s) of the original points.}
\item{bg}{The background color(s) of the original points.}
\item{flagcol}{The color to use for "flagging" each point.}
}
\details{
\samp{placeLabels} steps through the points indexed by \samp{x} and
\samp{y}, allowing the operator to manually place the labels for each
point. Each point is "flagged" by displaying a small colored circle (red
by default). When the label for that point has been placed, the original
symbol is displayed and the next point is flagged.
Each point and label can have different colors and backgrounds.
}
\note{
This function is handy for one-off plots with a moderate number of
points. It can be very useful for plots with clumps of points.
}
\value{nil - adds labels to an existing plot.}
\author{Jim Lemon - thanks to Marna Wagley for the idea.}
\seealso{\link{spread.labels}, \link{thigmophobe.labels}}
\examples{
# won't check because of the call to locator
\dontrun{
x<-rnorm(10)
y<-rnorm(10)
plot(x,y)
placeLabels(x,y,LETTERS[1:10],flagcol="purple")
}
}
\keyword{misc}
plotrix/man/brkdn.plot.Rd 0000755 0001762 0000144 00000011430 14011145766 015101 0 ustar ligges users \name{brkdn.plot}
\alias{brkdn.plot}
\title{A point/line plotting routine}
\description{Display a point/line plot of breakdowns of one or more variables.}
\usage{
brkdn.plot(vars,groups=NULL,obs=NULL,data,mct="mean",md="std.error",
stagger=NULL,dispbar=TRUE,main="Breakdown plot",xlab=NULL,ylab=NULL,xaxlab=NA,
ylim=NA,type="b",pch=1,lty=1,col=par("fg"),staxx=FALSE,yat=NULL,...)
}
\arguments{
\item{vars}{The names or indices of one or more columns in a data frame.
The columns must contain numeric data. If only one variable is to be
broken down, vars can be a formula.}
\item{groups}{The name or index of a column in a data frame that classifies
the values in \samp{vars} into different, usually fixed effect, levels.}
\item{obs}{The name or index of a column in a data frame that classifies
the values in \samp{vars} into different, usually random effect, levels.}
\item{data}{The data frame.}
\item{mct}{The measure of central tendency to calculate for each group.}
\item{md}{The measure of dispersion to calculate, NA for none.}
\item{stagger}{The amount to offset the successive values at each horizontal
position as a proportion of the width of the plot. The calculated default
is usually adequate. Pass zero for none.}
\item{dispbar}{Whether to display the measures of dispersion as bars.}
\item{main}{The title at the top of the plot.}
\item{xlab,ylab}{The labels for the X and Y axes respectively. There are
defaults, but they are basic.}
\item{xaxlab}{Optional labels for the horizontal axis ticks.}
\item{ylim}{Optional vertical limits for the plot.}
\item{type}{Whether to plot symbols, lines or both (as in \samp{plot}).}
\item{pch}{Symbol(s) to plot.}
\item{lty}{Line type(s) to plot.}
\item{col}{Color(s) for the symbols and lines.}
\item{staxx}{Whether to call \link{staxlab} to display the X axis
labels.}
\item{yat}{Optional y axis tick positions.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\value{
A list of two matrices of dimension \samp{length(levels(groups))} by
\samp{length(levels(obs))}. The first contains the measures of central
tendency calculated and its name is the name of the function passed as
\samp{mct}. The second contains the measures of dispersion and its name
is the name of the function passed as \samp{md}.
If both \samp{groups} and \samp{obs} are not NULL, the rows of each matrix
will be the \samp{groups} and the columns the \samp{obs}. If \samp{obs}
is NULL, the rows will be the \samp{groups} and the columns the \samp{vars}.
If \samp{groups} is NULL, the rows will be the \samp{vars} and the columns
the \samp{obs}. That is, if \samp{vars} has more than one element, if
\samp{obs} is NULL, the elements of \samp{vars} will be considered to
represent observations, while if \samp{groups} is NULL, they will be
considered to represent groups. At least one of \samp{groups} and \samp{obs}
must be not NULL or there is no point in using \samp{brkdn.plot}.
}
\details{
\samp{brkdn.plot} displays a plot useful for visualizing the breakdown of a
response measure by two factors, or more than one response measure by either
a factor representing something like levels of treatment (\samp{groups}) or
something like repeated observations (\samp{obs}). For example, if
observations are made at different times on data objects that receive
different treatments, the \samp{groups} factor will display the measures
of central tendency as points/lines with the same color, symbol and line type,
while the \samp{obs} factor will be represented as horizontal positions on the
plot. If \samp{obs} is numeric, its unique values will be used as the
positions, if not, 1 to the number of unique values. This is a common way of
representing changes over time intervals for experimental groups.
If only one numeric variable is to be broken down, \samp{vars} may be a
formula like \samp{var~groups+obs}. The position of the two factors to break
down the variable is fixed - the second term will be interpreted as "groups"
and the third, if present, will be interpreted as "obs".
}
\author{Jim Lemon}
\seealso{\link{dispersion}}
\examples{
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)
# now jazz it up a bit using medians and median absolute deviations
# and some enhancements
bp<-brkdn.plot(a~c+d,data=test.df,main="Test of the breakdown 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)
es<-emptyspace(bp)
legend(es,legend=c("Sydney","Gosford","Karuah","Brisbane"),pch=1:4,
col=1:4,lty=1:4,xjust=0.5,yjust=0.5)
}
\keyword{misc}
plotrix/man/gradient.rect.Rd 0000755 0001762 0000144 00000003302 14011145766 015554 0 ustar ligges users \name{gradient.rect}
\title{Display a rectangle filled with an arbitrary color gradient}
\usage{
gradient.rect(xleft,ybottom,xright,ytop,reds,greens,blues,col=NULL,
nslices=50,gradient="x",border=par("fg"))
}
\alias{gradient.rect}
\arguments{
\item{xleft,ybottom,xright,ytop}{Positions of the relevant corners
of the desired rectangle, as in \samp{rect}.}
\item{reds,greens,blues}{vectors of the values of the color components
either as 0 to 1 or ,if any value is greater than 1, 0 to 255.}
\item{col}{Vector of colors. If supplied, this takes precedence over
\samp{reds, greens, blues} and \samp{nslices} will be set to its length.}
\item{nslices}{The number of sub-rectangles that will be drawn.}
\item{gradient}{whether the gradient should be horizontal (x) or vertical.}
\item{border}{The color of the border around the rectangle (NA for none).}
}
\description{
\samp{gradient.rect} draws a rectangle consisting of \samp{nslices}
subrectangles of the colors in \samp{col} or those returned by
\samp{color.gradient} if \samp{col} is NULL. The rectangle is
'sliced' in the direction specified by \samp{gradient}.
}
\value{the vector of hexadecimal color values from \samp{color.gradient} or
\samp{col}.}
\author{Jim Lemon}
\examples{
# get an empty box
plot(0:10,type="n",axes=FALSE)
# run across the three primaries
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")
# now a "danger gradient"
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")
# now just a smooth gradient across the bar
gradient.rect(7,0,9,6,col=smoothColors("red",38,"blue"),border=NA)
}
\keyword{misc}
plotrix/man/perspx.Rd 0000755 0001762 0000144 00000001276 14011145766 014354 0 ustar ligges users \name{perspx}
\alias{perspx}
\title{ Display perspective plot }
\description{
Display an enhanced perspective plot with additional return values
}
\usage{
perspx(x,y,z,...)
}
\arguments{
\item{x,y,z}{ x, y and z coordinates to plot. }
\item{...}{ Other arguments passed to \samp{persp}. }
}
\details{
Displays \samp{z} values plotted on an x,y grid.
}
\value{
A list with three elements, the ranges of \samp{x}, \samp{y} and \samp{z}.
}
\author{Ben Bolker}
\examples{
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)
}
\keyword{misc}
plotrix/man/get.breaks.Rd 0000755 0001762 0000144 00000001200 14011145766 015043 0 ustar ligges users \name{get.breaks}
\alias{get.breaks}
\title{Get the breakpoints for a weighted histogram}
\description{
Gets the breakpoints for a weighted histogram.
}
\usage{
get.breaks(x,breaks)
}
\arguments{
\item{x}{A numeric vector.}
\item{breaks}{Either the name of the function to calculate breakpoints, the
number of categories or a vector of breakpoints.}
}
\details{
\samp{get.breaks} either calls the same functions as \samp{hist} to get
breakpoints or calculates a given number or just returns \samp{breaks}
if they are already specified.
}
\value{A vector of breakpoints.}
\author{Jim Lemon}
\seealso{\link{hist}}
\keyword{misc}
plotrix/man/seats.Rd 0000644 0001762 0000144 00000001335 14011145766 014143 0 ustar ligges users \name{seats}
\alias{seats}
\title{Arrange N seats in M semicircular rows}
\description{Compute seat positions in a semicircular parliament}
\usage{seats(N, M, r0 = 2.5)}
\arguments{
\item{N}{Total number of seats.}
\item{M}{Number of semicircular arcs on which to distribute the seats.}
\item{r0}{Radius of the inner arc in user units.}
}
\value{
A data frame including:
\item{x}{The x positions of the seats to be plotted on semi-circular
arcs.}
\item{y}{The y positions of the seats to be plotted on semi-circular
arcs.}
\item{r}{The row numbers for each seat.}
\item{theta}{The angle of each seat, going from pi to zero radians.}
}
\author{Duncan Murdoch and Barry Rowlingson}
\seealso{\link{election}}
\keyword{misc}
plotrix/man/polar.plot.Rd 0000755 0001762 0000144 00000004377 14110376232 015124 0 ustar ligges users \name{polar.plot}
\title{Plot values on a circular grid of 0 to 360 degrees}
\usage{
polar.plot(lengths,polar.pos=NULL,labels,label.pos=NULL,
start=0,clockwise=FALSE,rp.type="r",loglen=FALSE,explab=FALSE,...)
}
\alias{polar.plot}
\arguments{
\item{lengths}{numeric data vector. Magnitudes will be represented as
the radial positions of symbols, line ends or polygon vertices.}
\item{polar.pos}{numeric vector of positions on a 0:360 degree circle.
These will be converted to radians when passed to \samp{radial.plot}.}
\item{labels}{text labels to place on the periphery of the circle. This
defaults to labels every 20 degrees. For no labels, pass an empty string.}
\item{label.pos}{positions of the peripheral labels in degrees}
\item{start}{The position for zero degrees on the plot in degrees.}
\item{clockwise}{Whether to increase angles clockwise rather than the
default counterclockwise.}
\item{rp.type}{Whether to plot radial lines, symbols or a polygon.}
\item{loglen}{Whether to log transform the \samp{length} values. Only base
10 logs are available.}
\item{explab}{Whether to use the default fixed (FALSE) or exponential (TRUE)
notation for the radial labels.}
\item{...}{additional arguments passed to \samp{radial.plot} and
then to \samp{plot}.}
}
\description{
\samp{polar.plot} displays a plot of radial lines, symbols or a polygon
centered at the midpoint of the plot frame on a 0:360 circle.
Positions are interpreted as beginning at the right and moving
counterclockwise unless \samp{start} specifies another starting point or
\samp{clockwise} is TRUE.
If \samp{add=TRUE} is passed as one of the additional arguments, the values
will be added to the current plot. If a \samp{radial.lim} argument was
passed on the initial plot, it must be passed again to add values or the
values will be displayed incorrectly.
}
\value{A list of the parameters altered by \link{radial.plot}.}
\author{Jim Lemon}
\keyword{misc}
\seealso{\link{radial.plot}}
\examples{
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)
oldpar<-polar.plot(testlen,testpos,main="Test Clockwise Polar Plot",
radial.lim=c(0,15),start=90,clockwise=TRUE,lwd=3,line.col=4)
# reset everything
par(oldpar)
}
plotrix/man/clplot.Rd 0000755 0001762 0000144 00000002256 14011145766 014327 0 ustar ligges users \name{clplot}
\title{Plot lines with colors determined by values.}
\usage{
clplot(x,y,ylab=deparse(substitute(y)),xlab=deparse(substitute(x)),
levels=seq(min(y)+(max(y)-min(y))/5,max(y)-(max(y)-min(y))/5,length.out=4),
cols=c("black","blue","green","orange","red"),lty=1,showcuts=FALSE,...)
}
\alias{clplot}
\arguments{
\item{x,y}{numeric data vectors.}
\item{ylab,xlab}{Labels for the X and Y axes.}
\item{levels}{Cut points to assign colors to the values of \samp{x} and
\samp{y}.}
\item{cols}{The colors to be assigned.}
\item{lty}{The line type.}
\item{showcuts}{Whether to show the positions of the cut points.}
\item{...}{additional arguments passed to \samp{plot} or \samp{lines}.}
}
\description{
\samp{clplot} displays a plot of lines for which the colors are dependent
upon the x and y values. \samp{clplot} is similar to \samp{color.scale.lines}
except that while the latter calculates a color for each unique value,
\samp{clplot} assigns colors to groups of values within the cutpoints defined
by \samp{levels}.
}
\value{nil}
\author{Carl Witthoft}
\seealso{\link{plot}}
\examples{
x<-seq(1,100)
y<-sin(x/5)+x/20
clplot(x,y,main="Test of clplot")
}
\keyword{misc}
plotrix/man/count.overplot.Rd 0000755 0001762 0000144 00000002141 14011145766 016024 0 ustar ligges users \name{count.overplot}
\alias{count.overplot}
\title{Show overlying points as counts}
\usage{
count.overplot(x,y,tol=NULL,col=par("fg"),pch="1",...)
}
\arguments{
\item{x,y}{Two numeric data vectors or the first two columns of a matrix
or data frame. Typically the x/y coordinates of points to be plotted.}
\item{tol}{The largest distance between points that will be considered
to be overlying.}
\item{col}{Color(s) for the points (not the numbers).}
\item{pch}{Symbol(s) to display.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\description{
\samp{count.overplot} checks for overlying points defined as points
separated by a maximum of \samp{tol}, a two element numeric vector of
the x and y tolerance. Defaults to 1/2 of the width of a lower case
"o" in the x direction and 1/2 of the height of a lower case "o" in
the y direction.
}
\value{nil}
\keyword{misc}
\author{Jim Lemon}
\seealso{\link{cluster.overplot},\link{sizeplot}}
\examples{
xy.mat<-cbind(sample(1:10,200,TRUE),sample(1:10,200,TRUE))
count.overplot(xy.mat,main="count.overplot",
xlab="X values",ylab="Y values")
}
plotrix/man/zoomInPlot.Rd 0000755 0001762 0000144 00000003500 14011145766 015135 0 ustar ligges users \name{zoomInPlot}
\alias{zoomInPlot}
\title{
Display a plot with a rectangular section expanded in an adjacent plot
}
\description{
Display one plot on the left half of a device and an expanded section of that
plot on the right half of the device with connecting lines showing the expansion.
}
\usage{
zoomInPlot(x,y=NULL,xlim=NULL,ylim=NULL,rxlim=xlim,rylim=ylim,xend=NA,
zoomtitle=NULL,titlepos=NA,...)
}
\arguments{
\item{x,y}{numeric data vectors. If \samp{y} is not specified, it is set equal
to \samp{x} and \samp{x} is set to \samp{1:length(y)}.}
\item{xlim,ylim}{Limits for the initial plot.}
\item{rxlim,rylim}{Limits for the expanded plot. These must be within the above.}
\item{xend}{Where to end the segments that indicate the expansion. Defaults to
just left of the tick labels on the left ordinate.}
\item{zoomtitle}{The title of the plot, display in the top center.}
\item{titlepos}{The horizontal position of the title in user units of the
zoomed plot.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\details{
\samp{zoomInPlot} sets up a two column layout in the current device and calls
\samp{plot} to display a plot in the left column. It then draws a rectangle
corresponding to the \samp{rxlim} and \samp{rylim} arguments and displays a
second plot of that rectangle in the right column. It is currently very simple
and will probably become more flexible in future versions.
It just has. If \samp{rxlim} is set to NA, \samp{locator} will be called and
the user can define the zoomed rectangle by clicking on each corner. This is a
shameless ripoff of a suggestion by Greg Snow on the help list. Thanks, Greg.
}
\value{nil}
\author{Jim Lemon}
\seealso{\link{plot}}
\examples{
zoomInPlot(rnorm(100),rnorm(100),rxlim=c(-1,1),rylim=c(-1,1),
zoomtitle="Zoom In Plot",titlepos=-1.5)
}
\keyword{misc}
plotrix/man/labbePlot.Rd 0000644 0001762 0000144 00000005711 14011145766 014732 0 ustar ligges users \name{labbePlot}
\alias{labbePlot}
\title{ Display a L'Abbe plot }
\description{
Display the percentages of successes for two conditions to be compared as circles,
the area of which is proportional to the number of observations.
}
\usage{
labbePlot(x,main="L'Abbe plot",xlab="Percent positive response with placebo",
ylab="Percent positive response with treatment",labels=NULL,col=NA,
circle.mag=0.5,add=FALSE,...)
}
\arguments{
\item{x}{A list of either 2x2 tables or three element vectors (see Details).}
\item{main}{The title of the plot.}
\item{xlab,ylab}{The x and y axis labels as in \samp{plot}.}
\item{labels}{Text strings that will be displayed in the center of the circles.}
\item{col}{A list of colors for the circles.}
\item{circle.mag}{A fudge factor for very small or very large numbers of
observations.}
\item{add}{Whether to add the information in \samp{x} to an existing L'Abbe
plot.}
\item{...}{additional arguments passed to \samp{plot}.}
}
\details{
The elements of \samp{x} may be tables in which rows represent the conditions
being compared, with the comparison condition first (often "placebo") and the
condition of interest (often "intervention") second. The columns represent the
counts of successes and failures. The elements of \samp{x} can also be vectors
with three numeric values, first the percentage of successes for the comparison
condition, second the percentage of successes for the condition of interest and
finally the number of observations. Tables and vectors can be mixed.
The radius of each circle is the square root of the number of observations
multiplied by \samp{circle.mag}. This allows very small numbers of observations
to be expanded and very large numbers to be reduced in size. As the area of each
circle is proportional to the number of observations, \samp{circle.mag} must be
the same for all circles. The user may wish to expand or contract all the circles
on a plot so that they will fit within the box.
The labels, if not NULL, are displayed on the circles. The function tries to work
out whether white or black text will be more easily read based on the background
color and displays the text accordingly.
}
\value{nil}
\author{Jim Lemon - thanks to Whitney Melroy for asking for it.}
\seealso{\link{draw.circle}}
\examples{
# first fake something like the data from a clinical trial
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)
}
\keyword{misc}
plotrix/man/dotplot.mtb.Rd 0000755 0001762 0000144 00000004176 14011145766 015303 0 ustar ligges users \name{dotplot.mtb}
\alias{dotplot.mtb}
\title{ Minitab style dotplots. }
\description{
Create a dotplot of a data vector in the sense of "dotplot" as
used in the Minitab\eqn{\mbox{\copyright}} package.
}
\usage{
dotplot.mtb(x, xlim = NULL, main = NULL, xlab = NULL, ylab = NULL,
pch = 19, hist = FALSE, yaxis = FALSE, mtbstyle=TRUE)
}
\arguments{
\item{x}{ A numeric vector. }
\item{xlim}{ The x limits of the plot. }
\item{main}{ A title for the plot; defaults to blank.}
\item{xlab}{ A label for the x axis; defaults to blank.}
\item{ylab}{ A label for the y axis; defaults to blank.}
\item{pch}{ The plotting symbol for the dots in the plot;
defaults to a solid disc. }
\item{hist}{ Logical scalar; should the plot be done "histogram"
style, i.e. using vertical lines rather than stacks
of dots?}
\item{yaxis}{ Logical scalar; should a y-axis be produced? }
\item{mtbstyle}{ Logical scalar; should the dotplot be done in
the "Minitab" style? I.e. should the zero level
be at the vertical midway point? }
}
\details{
The result of \code{hist=TRUE} looks less ugly than stacks of
dots for very large data sets.
}
\value{
Nothing. A plot is produced as a side effect.
}
\author{ Barry Rowlingson
\email{B.Rowlingson@lancaster.ac.uk}
and Rolf Turner
\email{r.turner@auckland.ac.nz}
\url{http://www.stat.auckland.ac.nz/~rolf}
}
\section{Warnings}{
This function does something toadally different from the \code{dotplot()}
(now \code{\link{dotchart}()}) function in the graphics package.
The labelling of the \code{y}-axis is device dependent.
}
\examples{
\dontrun{
set.seed(42)
x <- rpois(100,10)
dotplot.mtb(x,main="No y-axis.")
dotplot.mtb(x,yaxis=TRUE,main="With y-axis displayed.")
dotplot.mtb(x,hist=TRUE,main="An \"h\" style plot.")
dotplot.mtb(x,xlim=c(4,16),main="With the x-axis limited.")
dotplot.mtb(x,yaxis=TRUE,mtbstyle=FALSE,main="Non-Minitab style.")
dotplot.mtb(x,yaxis=TRUE,xlab="x",ylab="count",
main="With x and y axis labels.")
}
}
\keyword{ hplot }
plotrix/man/ablineclip.Rd 0000755 0001762 0000144 00000003212 14011145766 015125 0 ustar ligges users \name{ablineclip}
\alias{ablineclip}
\title{Add a straight line to a plot}
\description{
As \samp{abline}, but has arguments \samp{x1,x2,y1,y2} as in \samp{clip}.
}
\usage{
ablineclip(a=NULL,b=NULL,h=NULL,v=NULL,reg=NULL,coef=NULL,untf=FALSE,
x1=NULL,x2=NULL,y1=NULL,y2=NULL,...)
}
\arguments{
\item{a}{Intercept.}
\item{b}{Slope.}
\item{h}{the y-value(s) for horizontal line(s).}
\item{v}{the x-value(s) for vertical line(s).}
\item{reg}{Fitted lm object. }
\item{coef}{Coefficients, typically intercept and slope.}
\item{untf}{How to plot on log coordinates, see \samp{abline}.}
\item{x1,x2,y1,y2}{Clipping limits, see \samp{clip}.}
\item{...}{Further arguments passed to \samp{abline}.}
}
\details{
\samp{ablineclip} sets a new clipping region and then calls \samp{abline}.
If any of the four clipping limits is NULL, the values from \samp{par("usr")}
are substituted. After the call to \samp{abline}, the old clipping region
is restored. In order to make \samp{clip} work, there is a call to \samp{abline} that draws a line off the plot.
Multiple lines of the same type can be drawn in a single call, but the clipping region must be the same for each group of lines. Thanks to Berry Boessenkool for pointing this out.
}
\value{
None. Adds to the current plot.
}
\author{ Remko Duursma }
\seealso{\link{abline}, \link{clip}}
\examples{
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")
}
\keyword{ aplot }
plotrix/DESCRIPTION 0000755 0001762 0000144 00000001566 14116113662 013475 0 ustar ligges users Package: plotrix
Version: 3.8-2
Date: 2021-09-08
Title: Various Plotting Functions
Author: Jim Lemon, Ben Bolker, Sander Oom,
Eduardo Klein, Barry Rowlingson,
Hadley Wickham, Anupam Tyagi,
Olivier Eterradossi, Gabor Grothendieck,
Michael Toews, John Kane, Rolf Turner,
Carl Witthoft, Julian Stander, Thomas Petzoldt,
Remko Duursma, Elisa Biancotto, Ofir Levy,
Christophe Dutang, Peter Solymos, Robby Engelmann,
Michael Hecker, Felix Steinbeck, Hans Borchers,
Henrik Singmann, Ted Toal, Derek Ogle, Darshan Baral,
Ulrike Groemping, Bill Venables
Maintainer: Jim Lemon
Imports: grDevices, graphics, stats, utils
Description: Lots of plots, various labeling, axis and color scaling functions.
License: GPL (>= 2)
NeedsCompilation: no
Packaged: 2021-09-08 10:15:08 UTC; root
Depends: R (>= 3.5.0)
Repository: CRAN
Date/Publication: 2021-09-08 11:00:02 UTC
plotrix/NEWS 0000755 0001762 0000144 00000042042 14114536641 012464 0 ustar ligges users version 3.8-2
fixed showcount option in sizetree
log10 plotting added to radial.plot family (thanks to Keziah Conroy)
added X and Y axis labels in gap.boxplot
version 3.8-1
dropped makeDendrite, plotDendrite and sumDendrite functions
version 3.7-8
Either axis in barp can now be omitted using the stax* arguments
HH:MM to decimal hour conversion with hm2dec argument in clock24.plot
Improved the placement of top.labels in pyramid.plot
Fixed color problem in floating.pie when zero or NA present
(thanks to Christoffer Flensburg)
Fixed label problem in radial.plot.labels
(thanks to Fabio Parracho Silva)
Added gap_barp function that will eventually replace gap.barplot
(thanks to Pamela Rueda-Cediel)
version 3.7-7
twoord.plot now calls axis.POSIXct for the x-axis if appropriate
fixed problem with conditional statements using "class"
version 3.7-6
fixed color.axis when "at" values are outside the plot limits
version 3.7-5
fixed the "empty list" bug in listDepth (thanks to Tingting Zhan)
new and elegant thigmophobe function (thanks to Bill Venables)
adjusted text size and placement in taylor.diagram for pos.cor=FALSE
added makeDensityMatrix and densityGrid functions
fixed functions that called 'barplot' (thanks to Martin Maechler)
version 3.7-4
fixed the dimension loss in color.scale when xrange specified
version 3.7-3
enhancement for gradient.rect function (thanks to Rod Lamming)
fix for gantt.chart function (thanks to Andrius Getzinis)
improvement to thigmophobe (thanks to Duncan Murdoch)
fixed specified legend position in the barp function
version 3.7-2
align plotrix-package.Rd with DESCRIPTION file
added user-specified labels to bumpchart
version 3.7-1
fix for the multivari function (thanks to Ulrike Groemping)
added the plotH function (thanks to Derek Ogle)
version 3.7
fixed brkdnNest due to changes arriving in R-3.4.3
added the joyPlot function
multivari plot function added (thanks to Ulrike Groemping)
version 3.6-6
added fill arguments to draw.circle (thanks to David Winsemius)
color2D.matplot now adds trailing zeros to values (thanks to Yuan Zhou)
a few ehancements to gantt.chart (thanks to Suman Khanal)
fixed the problem of asking for "l" type in polar.plot (thanks to Alex Pal)
improved version of violin_plot (thanks to Darshan Baral)
version 3.6-5
added the clustered.dotplots and violin_plot functions
fixed the extra call to plot in soil.texture (thanks to Dylan Beaudette)
added an option to radial.grid to allow it to display a blank grid
fixed a mysterious problem with equating one argument to another
in the box.heresy function
version 3.6-4
fixed a typo in twoord.plot that caused an error when the range
of the right axis went negative
added the jiggle function
changed the show.nulls argument in intersectDiagram to the nulls label
fixed the "fill" problem in textbox (thanks to Kohleth Chia)
added the placeLabels function
enhancement to raw.means.plot (thanks to Henrik Singmann)
added the binciW function, which fixes an error (thanks to Marc Girondot)
fixed the bug with displaying dispersion in barNest
version 3.6-3
fixed the errant y label in radial.pie
fixed the problem with degrees/radians in draw.ellipse (thanks to Wouter vander Bijl)
version 3.6-2
fixed the call to clip in rectFill (thanks to Cheng Zhou)
fixed the incorrect placing of some text in arctext (thanks to Mark Heckmann)
fixed the misbehaving y axis in brkdn.plot
improved the circumferential labels in clock24.plot
version 3.6-1
updated ehplot function (thanks to Robby Englemann)
pyramid.plot now displays trailing zeros (thanks to Simon Thornley)
problem with time/date x values in vectorField fixed
colors and staggering added to plot.dendrite (thanks to Marna Wagley)
version 3.6
fixed the missing left axis ticks in pyramid.plot (thanks to Jacob Clark)
corrected addtable2plot for log y plots (thanks to Andrew Metcalfe)
made the axis label and axis tick expansions the same in twoord.plot (thanks to wxj)
made the axis label and tick labels the same color as the axis in twoord.plot
added stack labels to the sizetree function
added imports now necessary for R CMD check
version 3.5-12
added choice of time axis (1 or 3) to gantt.chart (thanks to Mathias Collins)
added outlined error bars to the dispersion function (thanks to Michael Eisenring)
added a check for no variation in values to color.scale and color2D.matplot (thanks to Diego Calzolari)
version 3.5-11
changed my email address
version 3.5-10
added calculation method for SD in taylor.diagram (thanks to Melanie Moeller)
added the assembly seat distribution functions "seats" and "election"
(thanks to Barry Rowlingson and Duncan Murdoch)
fixed the rectangle border problem in legendg (thanks to Christian Graul)
version 3.5-9
added tangential labels to radial.plot
version 3.5-8
fixed the line length bug in feather.plot (thanks to Dr. Kazama)
version 3.5-6
added optional radial lines to the radial.grid function (thanks to Darren Obbard)
version 3.5-5
fixed the radial label bug in the radial.* functions (thanks to Mayeul Kauffmann)
changed the circumferential label suppress value in the radial.* functions to NULL
added the color.axis function
added log correction for boxed.labels (thanks to Flemming Skjøth)
fixed the breaks bug in histStack.default (thanks to Derek Ogle)
added scaled bar widths to barNest
version 3.5-3
fixed the problems with data frames and margins in battleship.plot (thanks to David Carlson)
set xpd=TRUE for the boxed.labels function (thanks to Francois Rousseu)
changed the pie.labels function to call text and adjust in x and y
added plain text labelling to pie.labels
tested for a current device in cluster.overplot and count.overplot (thanks to Markus Elze)
version 3.5-2
added the get.tablepos function (thanks to Peter Murakami)
passed the ... argument(s) to points and dispersion in brkdn.plot (thanks to Peter Mandeville)
added text adjustment for the circumferential labels to radial.plot
added the fill.corner function to do waffle plots (thanks to Zhao Jin)
version 3.5-1
added the tsxpos function (thanks to Prof J C Nash)
added a warning for off-axis labels to staxlab (thanks again to Prof Nash)
added the arrows argument to bumpchart (thanks to Jie)
added the axes argument to gap.boxplot (thanks to Shane Carey)
version 3.4-8
fixed a minor bug in the ylim argument of gap.plot
twoord.plot had some bugs cleaned up and now has a do.first argument
fixed the missing background colors in addtable2plot
allowed floating.pie to ignore zero and NA values (thanks to Jose deSantos)
added the "stax" argument to gap.plot (thanks to Zheng Lu)
fixed the problem with "yaxlab" in gap.barplot (thanks to Giorgio Galetti)
added the "histStack" and "plotH" functions (thanks to Derek Ogle)
version 3.4-7
added automatic spreading out to pie.labels
fixed the "priorities extremes" bug in gantt.chart (thanks to Michael Motta)
pyramid.plot now accepts NA values (thanks to Susumu Tanimura)
radial.plot now does a rank clock plot (thanks to Don Dennerline)
version 3.4-6
fixed the kite line positioning in kiteChart (thanks to Justin Dellinger)
version 3.4-5
fixed the upside down character bug in arctext
fixed the typo in the demo function for kite chart
version 3.4-4
added the radial.grid function to the NAMESPACE
version 3.4-3
minor bug that counted NAs in the propbrk function fixed
version 3.4-2
Character spacing and placement improved in draw.arc and arctext (thanks to Ted Toal)
radialtext and draw.radial.line functions added (also thanks to Ted Toal)
weighted.hist now allows a custom X axis to be displayed (thanks to Ben Graf)
Added the barlabels function
version 3.4-1
Fixed the alignment problem in pie3D and rationalized angle increments
Added the raw.means.plot functions contributed by Henrik Singmann
vastly improved the speed of the sizetree function
added the "varpos" argument to the kiteChart function - thanks to Nikolaus Lampardariou)
version 3.4
added the border argument to the sizetree function
multhist now returns all values from hist - thanks to John Muccigrosso
fixed a bug in addtable2plot that appeared on plots with a log x axis
fixed an almost invisible bug in drawSectorAnnulus - thanks to Denes
added the "mar" argument to pie3D - thanks to Qinghua Zhao
version 3.3-9
Fixed the bug in centipede.plot that I introduced in v3.3-8
version 3.3-8
added the horizontal grid argument to centipede plot (thanks to Colin Wahl)
version 3.3-7
Fixed a color bug in plotCI (thanks to Daniel Wollschlaeger)
version 3.3-6
Added the battleship plot (or Ford curve) thanks to Adam Maltese
Added the box.heresy function - thanks to Gianni Lavaredo
version 3.3-4
Added the display.na argument to the dispersion function (thanks to Lasse Jacobsen)
Removed the "Overall" bar in barNest when counts are being displayed
version 3.3-3
Fixed a bug in the Hinton diagram option (thanks to Xavier Fernández i Marín)
version 3.3-2
color2D.matplot will now display a Hinton diagram
added padding for negative values in twoord.plot (thanks to Hans Borcher)
added the maxEmptyRect function (thanks again to Hans Borchers)
version 3.3-1
expanded the color options and added top labels in sizetree
returned the frequency calculation in weighted.hist to what it used to be
version 3.3
fixed the vertical lines color in addtable2plot
fixed the frequency calculation in weighted.hist (thanks to Jarad Niemi)
added the size_n_color plot
version 3.2-8
added partitioning of intersections to intersectDiagram
version 3.2-7
bug fix for the examples in ladderplot
version 3.2-6
added the ruginv function after fixing some encoding problems
version 3.2-5
fixed a color assignment problem in plotCI
added automatic color assignment in sizetree where all levels use the same colors
version 3.2-4
Fixed the missing "shade" argument in pie3D (thanks to Jesse Brown)
Added specifiable priority legend label and extreme descriptors
(thanks to Pedro Reis)
Added the (experimental) radial.pie function
version 3.2-3
Fixed a few warnings from CRAN check (dotplot.mtb, gap.boxplot, symbolbarplot)
Added the ruginv function (thanks to Peter Solymos)
version 3.2-2
Added the labbePlot function (thanks to Whitney Melroy)
Fixed the showall argument problem in the barNest function
Fixed the problem with data frame input in the intersectDiagram function
version 3.2-1
Added the sumbrk function to brkdnNest (thanks to Kevin Burnham)
The dispbars function (just a call to dispersion) is now gone
Added user specified text colors to boxed.labels (thanks to Thorn Thaler)
Added the ehplot function (thanks to Robby, Michael & Felix)
version 3.2
Rewrote intersectDiagram to use equidistant spacing
Fixed a warning in oz.windrose.legend
Fixed default ordinate scaling in twoord.plot
Major rewrite of brkdnNest, barNest and drawNestedBars functions
Major rewrite of color.scale function
Added sliceArray function for barNest due to the above rewrite
version 3.1-2
Fixed a minor bug in intersectDiagram
version 3.1-1
Border colors added to gantt.chart (thanks to Brandon Fessler)
Extensive rewrite of the intersectDiagram function and helpers
Rewrite of the dendroPlot function
categoryReshape function added
version 3.1
intersectDiagram zero instance levels fixed
intersectDiagram now invisibly returns the list of intersections
Spacing within levels in intersectDiagram simplified
makeIntersectList now discards empty levels of intersection
makeIntersectList color assignment fixed
dendroPlot function added
version 3.0-9
Fixed the priority coloring problem in gantt.chart
Added optional vertical lines to addtable2plot (thanks to Bill Sperry)
Fixed the overshooting y axis for certain values of y in barp
version 3.0-8
Added semi-intelligent cell labelling to the color2D.matplot function
version 3.0-7
Fixed the right ordinate alignment in twoord.plot
version 3.0-6
Added the "barlabels" argument to drawNestedBars
big fix for the makeDendrite, furc and plot.dendrite functions
version 3.0-5
added Christophe Dutang's fix for the twoord.stackpoly function
fixed the confidence limit problem in barNest (I sincerely hope)
version 3.0-4
added semi-intelligent bar labelling to the sizetree function
added yaxs="i" to the empty plot in twoord.plot (thanks to Giles Crane)
added the Wilson binomial CI functions for brkdnNest
version 3.0-3
added the ladderplot function (thanks to Peter Solymos)
version 3.0-2
rewrote intersectDiagram to better display missing intersections
added a correction for character expansion to boxed.labels
fixed the count method for barNest
version 3.0-1
competely rewrote the barNest family of functions
removed labels for empty sets in intersectDiagram
version 3.0
fixed some minor problems with oz.windrose (thanks to Brad Evans)
added a 'locator' option to zoomInPlot (thanks to Greg Snow)
added the 'padj' argument to stackpoly for more tick label control
made the 'srt' argument work for both x and y axes in staxlab
fixed two little bugs in thigmophobe (thanks to Stephen Milborrow)
added the 'add' argument to radial.plot (thanks to Evan Daugharthy)
version 2.9-5
added the kiteChart function
added the "pos" argument to the getFigCtr function
version 2.9-4
added a calculated default vector of axis tick positions to twoord.plot
added a "mar" argument to the taylor.diagram function
version 2.9-3
added the gamma.col argument to taylor.diagram (thanks to Julian Arnold)
added the radial.labels function (thanks to Tali Vardi)
added the multiple colors per labels to gantt.chart (thanks to Nicolas Immelman)
added the rectFill function
added an option to the barp function to use rectFill
version 2.9-2
fixed the margin problem in staircase.plot
fixed the default y-axis tick placement in barp
version 2.9-1
fixed the "big gap" problem in the gap.plot function
added the twoord.stackplot function (thanks to Christophe Dutang)
version 2.9
added the panes function
fixed the border bug in color2D.matplot
fixed the indexing bug in drawNestedBars
version 2.8-4
added the triax.fill function which necessitated...
changed the initial plot call from triax.frame to triax.plot
removed the "main" argument from triax.frame
added brkdnNest to replace hierobrk
rewrote barNest to suit brkdnNest
added drawNestedBars for the display of barNest
changed all remaining hierobarp functions to barNest
version 2.8-3
radical rewrite of the pyramid.plot function
fixed up barp example mistake
fixed the title position in zoomInPlot
rewrote the hierobarp function as barNest
version 2.8-2
added the label.cex argument to the gantt.chart function
changed the name of the hierobarp function to barNest
version 2.8-1
added the calculation of proportions to hierobarp
version 2.8
added the cex argument to the staircase.plot function
added a bit to the plotCI function examples
changed \code tags to \samp and removed formatting from \link tags
added the ylog argument to the barp function (thanks to Fatima Kreusch)
added the legendg function (thanks to Primoz Peterlin)
removed the Piper diagram functions until they run correctly
version 2.7-2
added the axislab.cex argument to the twoord.plot function
version 2.7-1
added the getMarginWidth function
added the bracketing lines and labels to hierobarp
added the hierobarp.svymean and hierobarp.svyprop functions
added the lwd argument to stackpoly (thanks to Vaclav Varvarovsky)
included an example to show how to use gantt.chart without dates
included an example of histogram + density curve in twoord.plot
version 2.7
added the getFigCtr function
removed the final grouping lines from hierobarp
version 2.6-4
fixed the bug in hierobrk and hierobarp that got the order of
breakdown factors wrong
version 2.6-3
fixed the bug in gap.plot that lost the high values
version 2.6-2
complete rewrite of the hierobarp and hierobrk functions
rewrite of barhier function and name changed to sizetree
version 2.6-1
Minor bug fix in the gap.plot function.
Version 2.6
Improved bar/line plotting in the twoord.plot function.
Added the fullaxis function.
version 2.5-5
Changed the default symbol in count.overplot to "1".
Added bar plotting to the twoord.plot function.
Added fill between the confidence lines to the dispersion function.
Added the bumpchart function.
(Thanks to Andreas Christofferson for the idea)
Added the spreadout function to spread out cramped labels.
Added table cell size correction for the cex argument.
(Thanks to Brian Diggs for the patch)
version 2.5-4
Fixed the bug in dotplot.mtb function.
version 2.5-3
Introduced the hierobarp function.
Introduced the zoomInPlot function.
New version of dotplot.mtb (with bug)
previous versions
You don't expect me to remember all that, do you?
plotrix/R/ 0000755 0001762 0000144 00000000000 14114523773 012163 5 ustar ligges users plotrix/R/barp.R 0000755 0001762 0000144 00000011235 14011145766 013235 0 ustar ligges users barp<-function(height,width=0.4,names.arg=NULL,legend.lab=NULL,legend.pos=NULL,
col=NULL,border=par("fg"),main=NULL,xlab="",ylab="",xlim=NULL,ylim=NULL,x=NULL,
staxx=FALSE,staxy=FALSE,height.at=NULL,height.lab=NULL,cex.axis=par("cex.axis"),
pch=NULL,cylindrical=FALSE,shadow=FALSE,do.first=NULL,ylog=FALSE,srt=NULL,...) {
height.class<-attr(height,"class")
if(!is.null(height.class)) {
if(inherits(height.class,"dstat")) {
md1<-length(height)
md2<-dim(height[[1]])[2]
meanmat<-matrix(NA,nrow=md1,ncol=md2)
colnames(meanmat)<-colnames(height[[1]])
for(row in 1:md1) meanmat[row,]<-height[[row]][1,]
height<-meanmat
}
if(inherits(height.class,"freq")) height<-height[[1]]
}
if(is.data.frame(height)) its_ok<-is.numeric(unlist(height))
else its_ok<-is.numeric(height)
if(!its_ok) stop("barp can only display bars with numeric heights")
hdim<-dim(height)
if(is.null(x)) x<-1:length(height)
if(is.null(hdim) || length(hdim) == 1) {
ngroups<-length(height)
barcol<-col
barpinfo<-list(x=x,y=height)
hdim<-NULL
}
else {
ngroups<-hdim[2]
x<-1:ngroups
if(!is.matrix(col) && length(col)==hdim[1])
barcol<-matrix(rep(col,each=ngroups),nrow=hdim[1],byrow=TRUE)
else barcol<-col
if(!is.matrix(pch) && length(pch)==hdim[1])
pch<-matrix(rep(pch,ngroups),nrow=hdim[1])
barpinfo<-list(x=matrix(rep(1:ngroups,each=hdim[1]),ncol=hdim[2]),
y=as.matrix(height))
}
if(is.null(xlim)) xlim<-range(x)+c(-0.6,0.6)
negy<-any(height<0,na.rm=TRUE)
if(is.null(ylim)) {
if(negy) miny<-min(height,na.rm=TRUE)*1.05
else miny<-ifelse(ylog,min(height)/10,0)
ylim<-c(miny,max(height,na.rm=TRUE)*1.05)
}
else miny<-ylim[1]
plot(ylim[1],type="n",main=main,xlab=xlab,ylab=ylab,axes=FALSE,xlim=xlim,
ylim=ylim,xaxs="i",yaxs="i",log=ifelse(ylog,"y",""),...)
if(!is.null(do.first)) eval(parse(text=do.first))
if(negy) abline(h=0)
if(is.null(names.arg)) names.arg<-x
# staxx=NA omits x axis
if(!is.na(staxx)) {
if(staxx) {
axis(1,at=x,labels=rep("",ngroups),cex.axis=cex.axis)
staxlab(1,at=x,labels=names.arg,cex=cex.axis,srt=srt)
}
else axis(1,at=x,labels=names.arg,cex.axis=cex.axis)
if(is.null(height.at)) {
if(ylog) height.at<-axTicks(2,log=TRUE)
else height.at<-pretty(ylim)
if(max(height.at) > max(height,na.rm=TRUE))
height.at<-height.at[-length(height.at)]
}
if(is.null(height.lab)) height.lab<-height.at
}
if(!is.na(staxy)) {
if(staxy) {
axis(2,at=height.at,labels=rep("",length(height.lab)),cex.axis=cex.axis)
staxlab(2,at=height.at,labels=height.lab,cex=cex.axis,srt=srt)
}
else axis(2,at=height.at,labels=height.lab,cex.axis=cex.axis)
}
bottoms<-ifelse(negy,0,miny)
if(is.null(hdim)) {
if(shadow) {
for(bar in 1:ngroups)
polygon.shadow(c(x[bar]-width,x[bar]-width,x[bar]+width,x[bar]+width),
c(bottoms,height[bar],height[bar],bottoms),
offset=c(0.2*width,0.05*(height[bar]-ylim[2])))
}
if(cylindrical)
cylindrect(x-width,bottoms,x+width,height,col=barcol,
border=border)
else {
if(is.null(pch))
rect(x-width,bottoms,x+width,height,col=barcol,border=border)
else
rectFill(x-width,bottoms,x+width,height,bg="white",fg="black",
pch=pch)
}
}
else {
bottoms<-matrix(bottoms,nrow=hdim[1],ncol=hdim[2])
barwidth<-2*width/hdim[1]
for(subgroup in 1:hdim[1]) {
barpinfo$x[subgroup,]<-1:ngroups-width+(subgroup-0.5)*barwidth
if(shadow) {
for(bar in 1:ngroups) {
barleft<-bar-width+(subgroup-1)*2*width/hdim[1]
barright<-barleft+2*width/hdim[1]
polygon.shadow(c(barleft,barleft,barright,barright),
c(bottoms[bar],height[subgroup,bar],height[subgroup,bar],bottoms[bar]),
offset=c(0.2*width,0.05*(height[subgroup,bar]-ylim[2])))
}
}
if(cylindrical)
cylindrect(1:ngroups-width+(subgroup-1)*barwidth,bottoms[subgroup,],
1:ngroups-width+(subgroup)*barwidth,height[subgroup,],
col=barcol[subgroup,],border=border)
else {
if(is.null(pch))
rect(1:ngroups-width+(subgroup-1)*barwidth,bottoms[subgroup,],
1:ngroups-width+(subgroup)*barwidth,height[subgroup,],
col=barcol[subgroup,],border=border)
else
rectFill(1:ngroups-width+(subgroup-1)*barwidth,bottoms[subgroup,],
1:ngroups-width+(subgroup)*barwidth,height[subgroup,],
bg="white",fg="black",pch=pch[subgroup,])
}
}
}
if(!is.null(legend.lab)) {
xjust<-0
yjust<-1
if(is.null(legend.pos)) {
cat("Click at the upper left corner of the legend\n")
legend.pos<-locator(1)
}
legend(list(x=legend.pos[1],y=legend.pos[2]),legend=legend.lab,
fill=col,xjust=xjust,yjust=yjust)
}
box()
invisible(barpinfo)
}
plotrix/R/color.gradient.R 0000755 0001762 0000144 00000000155 14011145766 015222 0 ustar ligges users color.gradient<-function(reds,greens,blues,nslices=50) {
return(color.scale(1:nslices,reds,greens,blues))
}
plotrix/R/multsymbolbox.R 0000755 0001762 0000144 00000000653 14011145766 015233 0 ustar ligges users multsymbolbox<-function(x1,y1,x2,y2,tot,relw=0.8,fg=par("fg"),bg=par("bg"),
box=TRUE,debug=FALSE,...) {
x1 <- rep(x1, length(tot))
y1 <- rep(y1, length(tot))
x2 <- rep(x2, length(tot))
y2 <- rep(y2, length(tot))
fg <- rep(fg, length(tot))
bg <- rep(bg, length(tot))
for (i in 1:length(tot)) {
if (tot[i] > 0)
symbolbox(x1[i],y1[i],x2[i],y2[i],tot[i],relw=relw,
fg=fg[i],bg=bg[i],box=box,debug=debug,...)
}
}
plotrix/R/battleship.plot.R 0000644 0001762 0000144 00000002125 14011145766 015420 0 ustar ligges users battleship.plot<-function(x,mar=c(2,5,5,1),col="white",border="black",
main="",xlab="",ylab="",xaxlab=NULL,yaxlab=NULL,cex.labels=1,
maxxspan=0.45,maxyspan=0.45) {
dimx<-dim(x)
if(length(dimx) != 2)
stop("battleship.plot(x) where x is a 2 dimensional matrix or data frame")
if(is.data.frame(x)) x<-as.matrix(x)
oldmar<-par("mar")
par(mar=mar)
plot(0,xlim=c(0.5,dimx[2]+0.5),ylim=c(0.5,dimx[1]+0.5),axes=FALSE,
type="n",xlab="",ylab="")
title(main=main,line=mar[3]-2)
mtext(xlab,side=1,line=0)
if(is.null(xaxlab)) {
xaxlab<-colnames(x)
if(is.null(xaxlab)) xaxlab<-1:dimx[2]
}
staxlab(side=3,at=1:dimx[2],labels=xaxlab,srt=45,adj=0,top.line=0,
ticklen=0,cex=cex.labels)
if(is.null(yaxlab)) {
yaxlab<-rownames(x)
if(is.null(yaxlab)) yaxlab<-1:dimx[1]
}
staxlab(side=2,at=dimx[1]:1,labels=yaxlab,nlines=1,srt=0,adj=1,
top.line=0,ticklen=0,cex=cex.labels)
normx<-maxxspan*x/max(x,na.rm=TRUE)
rect(rep(1:dimx[2],each=dimx[1])-normx,rep(dimx[1]:1,dimx[2])-maxyspan,
rep(1:dimx[2],each=dimx[1])+normx,rep(dimx[1]:1,dimx[2])+maxyspan,
col=col,border=border)
par(mar=oldmar)
}
plotrix/R/boxed.labels.R 0000755 0001762 0000144 00000002764 14011145766 014662 0 ustar ligges users boxed.labels<-function (x, y = NULL, labels,
bg = ifelse(match(par("bg"), "transparent", 0), "white", par("bg")),
border = TRUE, xpad = 1.2, ypad = 1.2,
srt = 0, cex = 1, adj = 0.5, xlog=FALSE, ylog=FALSE, ...) {
oldpars <- par(c("cex", "xpd"))
par(cex = cex, xpd = TRUE)
if (is.null(y) && is.list(x)) {
y <- unlist(x[[2]])
x <- unlist(x[[1]])
}
box.adj <- adj + (xpad - 1) * cex * (0.5 - adj)
if (srt == 90 || srt == 270) {
bheights <- strwidth(labels)
theights <- bheights * (1 - box.adj)
bheights <- bheights * box.adj
lwidths <- rwidths <- strheight(labels) * 0.5
}
else {
lwidths <- strwidth(labels)
rwidths <- lwidths * (1 - box.adj)
lwidths <- lwidths * box.adj
bheights <- theights <- strheight(labels) * 0.5
}
args <- list(x = x, y = y, labels = labels, srt = srt, adj = adj,
col = ifelse(colSums(col2rgb(bg) * c(1, 1.4, 0.6)) <
350, "white", "black"))
args <- modifyList(args, list(...))
if(xlog){
xpad<-xpad*2
xr<-exp(log(x) - lwidths * xpad)
xl<-exp(log(x) + lwidths * xpad)
}
else{
xr<-x - lwidths * xpad
xl<-x + lwidths * xpad
}
if(ylog){
ypad<-ypad*2
yb<-exp(log(y) - bheights * ypad)
yt<-exp(log(y) + theights * ypad)
}
else{
yb<-y - bheights * ypad
yt<-y + theights * ypad
}
rect(xr, yb, xl, yt, col = bg, border = border)
do.call(text, args)
par(oldpars)
}
plotrix/R/axis.mult.R 0000755 0001762 0000144 00000002114 14011145766 014231 0 ustar ligges users axis.mult<-function(side=1,at=NULL,labels,mult=1,mult.label="",mult.line,
mult.labelpos=NULL,...) {
if(is.null(at)) at<-axTicks(side)
if(missing(labels)) labels<-at/mult
axis(side,at,labels,...)
mult.label<-paste(mult.label," (* ",mult," )",sep="",collapse="")
# multiplier position defaults to centered on the outside
if(is.null(mult.labelpos)) mult.labelpos<-side
edges<-par("usr")
if(side %% 2) {
# either top or bottom
if(mult.labelpos %% 2) {
adj<-0.5
at<-(edges[1]+edges[2])/2
if(missing(mult.line)) mult.line<-ifelse(mult.labelpos == side,3,0)
}
else {
adj<-ifelse(mult.labelpos == 2,1,0)
at<-ifelse(mult.labelpos == 2,edges[1],edges[2])
if(missing(mult.line)) mult.line<-1
}
}
else {
# either left or right
if(mult.labelpos %% 2) {
adj<-ifelse(mult.labelpos == 1,1,0)
at<-ifelse(mult.labelpos == 1,edges[3],edges[4])
if(missing(mult.line)) mult.line<-1
}
else {
adj<-0.5
at<-(edges[3]+edges[4])/2
if(missing(mult.line)) mult.line=ifelse(mult.labelpos == side,3,0)
}
}
mtext(mult.label,side,mult.line,at=at,adj=adj,...)
}
plotrix/R/plot_bg.R 0000644 0001762 0000144 00000000150 14011145766 013726 0 ustar ligges users plot_bg<-function(col="lightgray") {
plim<-par("usr")
rect(plim[1],plim[3],plim[2],plim[4],col=col)
}
plotrix/R/gap_barp.R 0000644 0001762 0000144 00000003306 14011145766 014061 0 ustar ligges users gap_barp<-function (height,gap,width=0.4,names.arg=names(height),
col=NULL,main="",xlab="",ylab="",xlim=NULL,ylim=NULL,x=NULL,
height.at=pretty(height),height.lab=NULL,...) {
if (missing(height)) stop("height values required")
hdim<-dim(height)
if(is.data.frame(height)) height<-as.matrix(height)
if(is.null(height.lab)) height.lab<-height.at
if(missing(gap)) stop("gap must be specified")
if(gap[1] > gap[2]) {
temp<-gap[2]
gap[2]<-gap[1]
gap[2]<-temp
}
if (length(ylab) == 0) ylab <- deparse(substitute(height))
if (is.null(col)) {
col<-color.gradient(c(0,1),c(0,1,0),c(1,0),length(height))
if(!is.null(dim(height))) col<-matrix(col,ncol=hdim[2])
}
else if(length(col) < length(height)) rep(col,length.out=length(height))
if(mean(gap) < 0) to_gap<-which(height < min(gap))
else to_gap<-which(height > max(gap))
if(length(to_gap) == 0) stop("no values outside gap")
if(any(height > gap[1] & height < gap[2])) {
warning("some heights within gap")
height[height > gap[1] & height < gap[2]]<-gap[2-(mean(gap) < 0)]
}
if(is.null(height.lab)) height.lab<-height.at
if(mean(gap) < 0) {
height[to_gap]<-height[to_gap] + diff(gap)
height.at[height.at < gap[1]]<-height.at[height.at < gap[1]] + diff(gap)
}
else {
height[to_gap]<-height[to_gap] - diff(gap)
height.at[height.at > gap[2]]<-height.at[height.at > gap[2]] - diff(gap)
}
if(is.null(hdim)) colnam<-names(height)
else colnam<-colnames(height)
barpinfo<-barp(height=height,names.arg=colnam,col=col,
main=main,xlab=xlab,ylab=ylab,
height.at=height.at,height.lab=height.lab,
xlim=xlim,ylim=ylim,x=x,...)
axis.break(2,gap[ifelse(mean(gap) > 0,1,2)],style="gap")
invisible(barpinfo)
}
plotrix/R/floatpie.R 0000755 0001762 0000144 00000005062 14011145766 014115 0 ustar ligges users # display a pie chart at an arbitrary location on an existing plot
floating.pie<-function(xpos=0,ypos=0,x,edges=200,radius=1,col=NULL,
startpos=0,shadow=FALSE,shadow.col=c("#ffffff","#cccccc"),
explode=0,...) {
# if no grahics device available, start one
if(is.null(dev.list))
plot(0,xlim=c(-1.5,1.5)*radius+xpos,ylim=c(-1.5,1.5)*radius+ypos,
type="n",axes=FALSE,xlab="",ylab="")
if (!is.numeric(x)) stop("floating.pie: x values must be numeric.")
validx<-which(!is.na(x) & x > 0)
col<-col[validx]
# scale the values of x 0 to 1
x<-c(0,cumsum(x[validx])/sum(x[validx]))
dx<-diff(x)
nx<-length(dx)
if (is.null(col)) col<-rainbow(nx)
else if(length(col) < nx) col<-rep(col,nx)
# scale the y radius so that it's a circle
xylim<-par("usr")
plotdim<-par("pin")
yradius<-
radius*(xylim[4]-xylim[3])/(xylim[2]-xylim[1])*plotdim[1]/plotdim[2]
# get the bisecting angles in radians
bc<-2*pi*(x[1:nx]+dx/2)+startpos
# don't dislay a shadow if any sectors are exploded
if(shadow && all(explode == 0)) {
xc<-c(cos(seq(0,2*pi,length=edges))*radius+xpos)
yc<-c(sin(seq(0,2*pi,length=edges))*yradius+ypos)
polygon.shadow(xc,yc,col=shadow.col)
}
if(length(explode) < nx) explode<-rep(explode,nx)
for(i in 1:nx) {
n<-max(2,floor(edges*dx[i]))
t2p<-2*pi*seq(x[i],x[i+1],length=n)+startpos
# calculate the positions of the arc plus the center
xc<-c(cos(t2p)*radius+xpos,xpos)
yc<-c(sin(t2p)*yradius+ypos,ypos)
if(explode[i]) {
xc<-xc + cos(bc[i]) * explode[i]
yc<-yc + sin(bc[i]) * explode[i]
}
polygon(xc,yc,col=col[i],...)
t2p<-2*pi*mean(x[i+0:1])+startpos
xc<-cos(t2p)*radius
yc<-sin(t2p)*radius
}
invisible(bc)
}
# place plain or boxed labels at the specified distance from x,y on the
# radial lines specified by angles.
pie.labels<-function(x=0,y=0,angles,labels,radius=1.05,bg="white",
border=TRUE,minangle=NA,boxed=FALSE,explode=0,...) {
if(missing(angles) || missing(labels))
stop("Angles and labels must be specified.")
# turn off clipping
par(xpd=TRUE)
# scale the y radius
xylim<-par("usr")
plotdim<-par("pin")
yradius<-radius*(xylim[4]-xylim[3])/(xylim[2]-xylim[1])*plotdim[1]/plotdim[2]
if(!is.na(minangle)) angles<-spreadout(angles,minangle)
xc<-cos(angles)*(radius+explode)+x
yc<-sin(angles)*(yradius+explode)+y
for(label in 1:length(labels)) {
label.adj<-c(abs(1-cos(angles[label]))/2,abs(1-sin(angles[label]))/2)
if(boxed)
boxed.labels(xc[label],yc[label],labels[label],adj=label.adj,
border=border,...)
else text(xc[label],yc[label],labels[label],adj=label.adj,...)
}
# turn clipping back on
par(xpd=FALSE)
}
plotrix/R/ruginv.R 0000644 0001762 0000144 00000002455 14011145766 013624 0 ustar ligges users ruginv<-function(x,ticksize=0.03,side=1,lwd=0.5,col=par("fg"),
col.ticks="white",quiet=getOption("warn")<0,...) {
x<-as.vector(x)
ok=is.finite(x)
x<-x[ok]
if(!quiet) {
u<-par("usr")
if(side%%2 == 1) {
if(par("xlog")) u<-10^u[1:2]
else u<-u[1:2]
}
else {
if(par("ylog")) u<-10^u[3:4]
else u<-u[3:4]
}
if(any(x < u[1] | x > u[2])) warning("Some values will be clipped")
}
u<-par("usr")
par("pin")
if(ticksize < 0.5) tic<-min(diff(u[3:4]),diff(u[1:2]))*ticksize
else tic<-ifelse(side%%2 == 1,diff(u[3:4]),diff(u[1:2]))*ticksize
if(ticksize < 0) opar<-par(xpd=TRUE)
switch(as.character(side),
"1"=polygon(u[c(1,2,2,1,1)],u[3]+c(0,0,tic,tic,0),col=col,border=NA,...),
"2"=polygon(u[1]+c(0,0,tic,tic,0),u[c(3,4,4,3,3)],col=col,border=NA,...),
"3"=polygon(u[c(1,2,2,1,1)],u[4]+c(0,0,-tic,-tic,0),col=col,border=NA,...),
"4"=polygon(u[2]+c(0,0,-tic,-tic,0),u[c(3,4,4,3,3)],col=col,border=NA,...))
switch(as.character(side),
"1"=sapply(x,function(z) lines(c(z,z),u[3]+c(0,tic),col=col.ticks,lwd=lwd)),
"2"=sapply(x,function(z) lines(u[1]+c(0,tic),c(z,z),col=col.ticks,lwd=lwd)),
"3"=sapply(x,function(z) lines(c(z,z),u[4]+c(0,-tic),col=col.ticks,lwd=lwd)),
"4"=sapply(x,function(z) lines(u[2]+c(0,-tic),c(z,z),col=col.ticks,lwd=lwd)))
if(ticksize < 0) par(opar)
invisible(x)
}
plotrix/R/stackpoly.R 0000755 0001762 0000144 00000003553 14011145766 014326 0 ustar ligges users stackpoly<-function(x,y=NULL,main="",xlab="",ylab="",xat=NA,xaxlab=NA,
xlim=NA,ylim=NA,lty=1,lwd=1,border=NA,col=NULL,staxx=FALSE,stack=FALSE,
axis2=TRUE,axis4=TRUE,padj=0,...) {
ydim<-dim(y)
if(is.null(y[1])) {
y<-x
ydim<-dim(y)
if(is.null(ydim)) x<-1:length(y)
else x<-matrix(rep(1:ydim[1],ydim[2]),ncol=ydim[2])
}
# fix when x is a vector and y a matrix - Phil Novack-Gottshall
if(!identical(dim(x),ydim)) x<-matrix(rep(x,ydim[2]),ncol=ydim[2])
if(stack) y<-t(unlist(apply(as.matrix(y),1,cumsum)))
if(is.na(xlim[1])) xlim<-range(x)
if(is.na(ylim[1])) ylim<-range(y)
plot(0,main=main,xlab=xlab,ylab=ylab,xlim=xlim,ylim=ylim,type="n",
xaxs="i",yaxs="i",axes=FALSE,...)
if(is.matrix(y) || is.list(y)) {
plotlim<-par("usr")
if(is.na(xat[1])) xat<-x[,1]
if(is.na(xaxlab[1])) xaxlab<-xat
if(staxx) staxlab(at=xat,labels=xaxlab)
else axis(1,at=xat,labels=xaxlab,padj=padj)
if(axis2) axis(2)
if(axis4) axis(4)
if(is.null(col[1])) col=rainbow(ydim[2])
else if(length(col)leny) nseg<-leny-1
}
if(is.na(col[1])) {
# if colors are not supplied
if(is.na(colvar[1]))
# if a separate variable is not supplied, use running average of y pairs
lcol<-color.scale((y[1:nseg]+y[2:(nseg+1)])/2,reds,greens,blues)
# assume that colvar refers to the intervals, not the x/y points
else lcol<-color.scale(colvar,reds,greens,blues)
}
else lcol=col
segments(x[1:nseg],y[1:nseg],x[2:(nseg+1)],y[2:(nseg+1)],col=lcol,...)
}
plotrix/R/cluster.overplot.R 0000755 0001762 0000144 00000002035 14011145766 015641 0 ustar ligges users cluster.overplot<-function(x,y,away=NULL,tol=NULL,...) {
if(missing(x)) stop("Usage: cluster.overplot(x,y,away=NULL,tol=NULL)")
dimx<-dim(x)
if(missing(y) && !is.null(dimx)) {
y<-x[,2]
x<-x[,1]
}
xlen<-length(x)
if(xlen != length(y)) stop("x and y must be the same length.")
if(dev.cur() == 1) plot(x,y,main="",xlab="",ylab="",axes=FALSE,type="n")
if(is.null(away)) away<-c(strwidth("o"),5*strheight("o")/8)
if(is.null(tol)) tol<-c(strwidth("o")/2,strheight("o")/2)
away.x<-c(0,-away[1],away[1],0,0,-away[1],away[1],-away[1],away[1])
away.y<-c(0,0,0,-away[2],away[2],-away[2],away[2],away[2],-away[2])
flags<-1:xlen
for(i in 1:xlen) {
if(!is.na(flags[i])) {
overplots<-abs(x-x[i]) <= tol[1] & abs(y - y[i]) <= tol[2]
if(sum(overplots) > 1) {
away.index<-1
for(j in 1:xlen) {
if(overplots[j]) {
x[j]<-x[j]+away.x[away.index]
y[j]<-y[j]+away.y[away.index]
away.index<-away.index+1
if(away.index > 9) away.index<-1
}
}
}
}
flags[overplots] <- NA
}
return(list(x=x,y=y,...))
}
plotrix/R/ladderplot.R 0000755 0001762 0000144 00000000102 14011145766 014432 0 ustar ligges users ladderplot <-
function (x, ...)
UseMethod("ladderplot")
plotrix/R/lengthKey.R 0000755 0001762 0000144 00000000530 14011145766 014237 0 ustar ligges users lengthKey<-function(x,y,tickpos,scale) {
par(xpd=TRUE)
nticks<-length(tickpos)
segments(x,y,x+tickpos[nticks]*scale,y)
for(tick in 1:nticks) {
segments(x+tickpos[tick]*scale,y,
x+tickpos[tick]*scale,y+tickpos[nticks]*scale/20)
text(x+tickpos[tick]*scale,y+tickpos[nticks]*scale/15,
tickpos[tick],adj=c(0.5,0))
}
par(xpd=FALSE)
}
plotrix/R/draw.arc.R 0000755 0001762 0000144 00000003725 14011145766 014017 0 ustar ligges users draw.arc <- function(x=1, y=NULL, radius=1, angle1=deg1*pi/180,
angle2=deg2*pi/180, deg1=0, deg2=45, n=0.05, col=NA, lwd=NA, ...) {
if (all(is.na(col)))
col <- par("col")
if (all(is.na(lwd)))
lwd <- par("lwd")
xylim<-par("usr")
ymult <- getYmult()
devunits <- dev.size("px")
draw.arc.0 <- function(x, y, radius, angle1, angle2, n, col, lwd, ...)
{
delta.angle <- (angle2 - angle1)
if (n != as.integer(n))
n <- as.integer(1+delta.angle/n) # Divide total angle by desired segment angle to get number of segments
delta.angle <- delta.angle/n
angleS <- angle1 + seq(0, length=n) * delta.angle
angleE <- c(angleS[-1], angle2)
# Move segment starts/ends so that segments overlap enough to make wide segments
# not have an open slice in them. The slice is open by delta.angle*half.lwd.user.
# That subtends an angle of that/(radius+half.lwd.user) radians, from center.
# Move segment endpoints by half of that, so together they equal that.
if (n > 1)
{
half.lwd.user <- (lwd/2)*(xylim[2]-xylim[1])/devunits[1]
adj.angle = delta.angle*half.lwd.user/(2*(radius+half.lwd.user))
angleS[2:n] = angleS[2:n] - adj.angle
angleE[1:(n-1)] = angleE[1:(n-1)] + adj.angle
}
p1x <- x + radius * cos(angleS)
p1y <- y + radius * sin(angleS) * ymult
p2x <- x + radius * cos(angleE)
p2y <- y + radius * sin(angleE) * ymult
segments(p1x, p1y, p2x, p2y, col=col, lwd=lwd, ...)
}
xy <- xy.coords(x, y)
x <- xy$x
y <- xy$y
a1 <- pmin(angle1, angle2)
a2 <- pmax(angle1, angle2)
angle1 <- a1
angle2 <- a2
args <- data.frame(x, y, radius, angle1, angle2, n, col, lwd, stringsAsFactors=FALSE)
for (i in 1:nrow(args))
do.call("draw.arc.0", c(args[i, ], ...))
invisible(args)
}
plotrix/R/densityGrid.R 0000644 0001762 0000144 00000007332 14011145766 014576 0 ustar ligges users # incoming data frame must be latitude, longitude and optionally intensity
# as individual vectors or a list or data frame containing these
makeDensityMatrix<-function(x,y,z=NULL,nx=100,ny=50,zfun=c("mean","sum"),
xlim=c(-180,180),ylim=c(-90,90),geocoord=TRUE) {
if(is.list(x)) {
y<-x[[1]]
# if there is a third column, it's intensity
if(length(x) > 2) z<-x[[3]]
x<-x[[2]]
}
xbreaks<-seq(xlim[1],xlim[2],length.out=nx+1)
ybreaks<-seq(ylim[1],ylim[2],length.out=ny+1)
xcells<-as.numeric(cut(x,xbreaks,include.lowest=TRUE))
# reverse the y (latitude) limits as the matrix displays from the top down
ycells<-(ny+1)-as.numeric(cut(y,ybreaks,include.lowest=TRUE))
# discard any NA values resulting from observations outside the lat/lon limits
notNA<-!is.na(xcells) & !is.na(ycells)
xcells<-xcells[notNA]
ycells<-ycells[notNA]
# need two matrices, one for counts, one for intensities
densmat<-matrix(0,nrow=ny,ncol=nx)
# midpoints of the y (latitude) cells to correct for shrinkage of area
# abs is needed to prevent negative secants in southern latitudes
if(geocoord) ymult<-1/cos(pi*abs(ybreaks[1:ny]+ybreaks[1:ny+1])/360)
else ymult<-rep(1,ny)
# equivalent to "table" except that it preserves zero cell counts
for(i in 1:ny) densmat[i,]<-tabulate(xcells[ycells==i],nx)*ymult[i]
if(is.null(z)) {
cat("Range of density (>0) -",range(densmat[densmat > 0]),"\n")
return(densmat)
} else {
intensmat<-matrix(0,nrow=ny,ncol=nx)
# accumulates the 'z' values in the appropriate grid cells
for(i in 1:length(xcells))
intensmat[ycells[i],xcells[i]]<-intensmat[ycells[i],xcells[i]]+z[i]
# calculate the mean intensity of all non-zero density cells
if(zfun[1] == "mean")
intensmat[densmat > 0]<-intensmat[densmat > 0]/densmat[densmat > 0]
cat("Range of density (>0) -",range(densmat[densmat > 0]),"\n")
cat("Range of intensity (>0) -",range(intensmat[intensmat > 0]),"\n")
return(list(densmat,intensmat))
}
}
# x is either a matrix of cell frequencies or a list containing matrices of
# cell frequencies and cell intensities
densityGrid<-function(x,z=NULL,xrange=NA,zrange=NA,range.cex=c(1,10),
xlim=c(-180,180),ylim=c(-90,90),red=c(0,1),green=c(0,1),blue=c(0,1),alpha=1,
pch=".",geocoord=TRUE) {
# if x is a list of two matrices, the second will be intensity values
if(is.list(x)) {
z<-x[[2]]
if(is.na(zrange[1])) {
zrange<-pretty(range(z[z>0]))
zrange<-zrange[c(1,length(zrange))]
}
x<-x[[1]]
}
if(is.na(xrange[1])) {
xrange<-pretty(range(x[x>0]))
xrange<-xrange[c(1,length(xrange))]
}
# get the dimensions of the matrix x
dimx<-dim(x)
# calculate the half grid increments in user units on the plot
posinc1<-0.5*diff(ylim)/dimx[1]
posinc2<-0.5*diff(xlim)/dimx[2]
# calculate the positions of the centers of the cells
xpos<-rep((seq(xlim[1],xlim[2],length.out=dimx[2]+1)-posinc2)[-1],each=dimx[1])
ypos<-rep((seq(ylim[2],ylim[1],length.out=dimx[1]+1)+posinc1)[-1],dimx[2])
# get the order of ascending counts in the matrix
m2v<-order(x)
if(is.null(z)) {
# calculate the expansion for the symbols - areas proportional to counts
if(length(range.cex) > 1) cexs<-rescale(x,range.cex)
else cexs<-rep(range.cex[1],dimx[1])
# color repeats cell count
cols<-x
cols[x>0]<-color.scale(x[x>0],cs1=red,cs2=green,cs3=blue,alpha=alpha,
xrange=xrange)
} else {
# areas proportional to cell count
if(length(range.cex) > 1) {
cexs<-x
cexs[x>0]<-rescale(x[x>0],range.cex)
}
else cexs<-rep(range.cex[1],dimx[1])
# color is cell intensity
cols<-z
cols[x>0]<-color.scale(z[x>0],cs1=red,cs2=green,cs3=blue,alpha=alpha,
xrange=zrange)
}
# display the points - don't display anything in cells with zero counts
for(i in m2v) {
if(x[i] > 0) points(xpos[i],ypos[i],pch=pch,cex=cexs[i],col=cols[i])
}
}
plotrix/R/polygon.shadow.R 0000755 0001762 0000144 00000001230 14011145766 015256 0 ustar ligges users polygon.shadow<-function(x,y=NULL,offset=NA,inflate=NA,
col=c("#ffffff","#cccccc")) {
if(is.null(y)) {
if(is.null(x$y)) stop("both x and y coordinates must be given")
y<-x$y
x<-x$x
}
xcenter<-mean(x)
ycenter<-mean(y)
if(is.na(offset[1])) offset<-c((max(x)-min(x))/20,-(max(y)-min(y))/20)
if(length(col) == 2) col<-smoothColors(col[1],8,col[2])
if(is.na(inflate[1])) {
multx<-seq(offset[1],0,length=10)
multy<-seq(offset[2],0,length=10)
}
else {
multx<-seq(inflate[1],0,length=10)
multy<-seq(inflate[2],0,length=10)
}
for(i in 1:10)
polygon(x+multx[i]*(x-xcenter)+offset[1],y+multy[i]*(y-ycenter)+offset[2],
col=col[i],border=NA)
}
plotrix/R/bumpchart.R 0000755 0001762 0000144 00000002220 14011145766 014270 0 ustar ligges users bumpchart<-function(y,top.labels=colnames(y),labels=rep(rownames(y),2),
rank=TRUE,mar=c(2,8,5,8),pch=19,col=par("fg"),lty=1,lwd=1,arrows=FALSE,
...) {
if(missing(y)) stop("Usage: bumpchart(y,top.labels,labels,...)")
ydim<-dim(y)
if(is.null(ydim)) stop("y must be a matrix or data frame")
oldmar<-par("mar")
par(mar=mar)
if(rank) y<-apply(y,2,rank)
# to get things the right way round, reverse the order of everything
labels<-rev(labels)
pch=rev(pch)
col=rev(col)
lty=rev(lty)
lwd=rev(lwd)
y<-apply(y,2,rev)
if(arrows) {
matplot(t(y),ylab="",type="p",pch=pch,col=col,axes=FALSE)
for(row in 1:(ydim[2]-1))
p2p_arrows(rep(row,ydim[1]),y[,row],rep(row+1,ydim[1]),y[,row+1],
col=col,lty=lty,lwd=lwd,...)
}
else
matplot(t(y),ylab="",type="b",pch=pch,col=col,lty=lty,lwd=lwd,axes=FALSE,...)
par(xpd=TRUE)
xylim<-par("usr")
minspacing<-strheight("M")*1.5
text(1:ydim[2],xylim[4]+(xylim[4]-xylim[3])/20,top.labels)
labelpos<-spreadout(y[,1],minspacing)
text(xylim[1],labelpos,labels[1:ydim[1]],adj=1)
labelpos<-spreadout(y[,ydim[2]],minspacing)
text(xylim[2],labelpos,labels[(ydim[1]+1):(2*ydim[1])],adj=0)
par(mar=oldmar,xpd=FALSE)
}
plotrix/R/gap.barplot.R 0000755 0001762 0000144 00000004452 14011145766 014525 0 ustar ligges users gap.barplot<-function (y,gap,xaxlab,xtics,yaxlab,ytics,xlim=NA,ylim=NA,
xlab=NULL,ylab=NULL,horiz=FALSE,col=NULL,...) {
if (missing(y)) stop("y values required")
if(missing(xtics)) xtics <- 1:length(y)
if (missing(gap)) stop("gap must be specified")
if (is.null(ylab)) ylab <- deparse(substitute(y))
if (is.null(col)) col <- color.gradient(c(0,1),c(0,1,0),c(1,0),length(y))
else if(length(col) < length(y)) rep(col,length.out=length(y))
littleones <- which(y <= gap[1])
bigones <- which(y >= gap[2])
valid.y<-y[!is.na(y)]
if(any(valid.y > gap[1] & valid.y < gap[2]))
warning("gap includes some values of y")
gapsize <- gap[2] - gap[1]
if(missing(xaxlab)) xaxlab <- as.character(xtics)
if(is.na(xlim[1])) xlim <- range(xtics)
if(is.na(ylim[1])) ylim <- c(min(valid.y)-gapsize,max(valid.y)-gapsize)
cat("ylim",ylim,"\n")
#if(ylim[1] < 0) ylim[1]<-0
if(missing(ytics)) ytics <- pretty(y)
if(any(ytics<0)) ytics<-ytics[ytics >= 0]
if(missing(yaxlab)) yaxlab <- ytics
littletics <- which(ytics < gap[1])
bigtics <- which(ytics >= gap[2])
halfwidth <- min(diff(xtics))/2
if(horiz) {
if(!is.null(xlab)) {
tmplab<-xlab
xlab<-ylab
ylab<-tmplab
}
plot(0,xlim=ylim,ylim=xlim,xlab=xlab,ylab=ylab,axes=FALSE,type="n",...)
plot.lim <- par("usr")
botgap<-ifelse(gap[1]<0,gap[1],ylim[1])
box()
axis(2,at=xtics,labels=xaxlab,...)
axis(1,at=c(ytics[littletics],ytics[bigtics]-gapsize),
labels=c(yaxlab[littletics],yaxlab[bigtics]),...)
rect(botgap,xtics[y dir.breaks[dir] && dir < ndir) dir<-dir+1
if(winddir[i] > dir.breaks[ndir]) dir<-1
speed<-1
while(windspeed[i] > speed.breaks[speed] && speed < nspeeds) speed<-speed+1
windagg[speed,dir]<-windagg[speed,dir]+1
}
windagg<-100*windagg/sum(windagg)
return(windagg)
}
oz.windrose.legend<-function(maxpct=20,scale.factor=30,
speed.col=c("#dab286","#fe9a66","#ce6733","#986434"),
speed.width=NA,legend.pos=NA) {
wdnames<-c("E","NE","N","NW","W","SW","S","SE")
if(is.na(speed.width[1])) speed.width<-maxpct*1:4/100
if(is.na(legend.pos[1])) legend.pos<-maxpct*1.25
draw.circle(-maxpct/2,legend.pos,maxpct/20)
angles<-seq(0,7*pi/4,by=pi/4)
for(i in 1:8) {
x<-cos(angles[i])*c(maxpct/20,maxpct/16,maxpct/10)-maxpct/2
y<-sin(angles[i])*c(maxpct/20,maxpct/16,maxpct/10)+legend.pos
segments(x[1],y[1],x[2],y[2])
text(x[3],y[3],wdnames[i],cex=0.7)
}
wsnames<-c("1-10","10-20","20-30","30+")
draw.circle(-maxpct/30,legend.pos,maxpct/30)
for(i in 1:length(speed.col)) {
x<-c(i-1,i)*maxpct/4
y<-c(legend.pos-speed.width[i],legend.pos+speed.width[i])
polygon(c(x[1],x[1],x[2],x[2]),c(y[1],y[2],y[2],y[1]),col=speed.col[i])
text((x[1]+x[2])/2,legend.pos-maxpct/15,wsnames[i],cex=0.7)
}
text(-maxpct/30,legend.pos+maxpct/10,"Calm")
text(maxpct/2,legend.pos+maxpct/10,"km/h")
text(maxpct/2,legend.pos-maxpct/8,paste("Scale factor = ",scale.factor,"%",sep=""))
}
oz.windrose<-function(windagg,maxpct=20,wrmar=c(4,5,6,5),
scale.factor=30,speed.col=c("#dab286","#fe9a66","#ce6733","#986434"),
speed.width=NA,show.legend=TRUE,legend.pos=NA,...) {
if(is.na(speed.width[1])) speed.width<-maxpct*1:4/100
if(is.na(legend.pos[1])) legend.pos<-maxpct*1.25
oldmar<-par("mar")
par(mar=wrmar,xpd=TRUE)
plot(0,xlim=c(-maxpct,maxpct),ylim=c(-maxpct,maxpct),type="n",
axes=FALSE,xlab="",ylab="",...)
winddim<-dim(windagg)
calm.radius<-sum(windagg[1,])/winddim[2]
rad<-10
while(rad<=maxpct) {
draw.circle(0,0,rad+calm.radius,border="gray")
boxed.labels(rad+calm.radius,maxpct/10,paste(rad,"%",sep=""),ypad=0.7,border=FALSE)
rad<-rad+10
}
draw.circle(0,0,calm.radius,border="gray")
angle.inc<--2*pi/winddim[2]
angles<-seq(5*pi/2,pi/2+angle.inc,by=angle.inc)
descpct<-order(colSums(windagg),decreasing=TRUE)
for(i in descpct) {
next.radius<-calm.radius
for(j in 2:winddim[1]) {
xinner<-cos(angles[i])*next.radius
xouter<-cos(angles[i])*(windagg[j,i]+next.radius)
yinner<-sin(angles[i])*next.radius
youter<-sin(angles[i])*(windagg[j,i]+next.radius)
next.radius<-sqrt(xouter*xouter+youter*youter)
# find the four points for each rectangle
xoffset<-cos(angles[i]-pi/2)*speed.width[j-1]
yoffset<-sin(angles[i]-pi/2)*speed.width[j-1]
polygon(c(xinner-xoffset,xinner+xoffset,xouter+xoffset,xouter-xoffset),
c(yinner-yoffset,yinner+yoffset,youter+yoffset,youter-yoffset),
col=speed.col[j-1])
}
}
text(-maxpct,maxpct/4,paste("Calm ",round(sum(windagg[1,]),1),"%",sep=""),col="blue")
if(show.legend)
oz.windrose.legend(maxpct=maxpct,scale.factor=scale.factor,speed.col=speed.col,
speed.width=speed.width,legend.pos=legend.pos)
par(oldmar)
}
plotrix/R/placeLabels.R 0000644 0001762 0000144 00000002112 14011145766 014507 0 ustar ligges users placeLabels<-function(x,y=NA,labels,pointer=TRUE,cex=1,labelcol=par("fg"),
labelbg="white",border=par("fg"),pointercol=par("fg"),
pch=1,col=1,bg="white",flagcol="red") {
if(is.na(y) && is.list(x)) {
y<-unlist(x[[2]])
x<-unlist(x[[1]])
}
nlabels<-length(labels)
if(length(labelcol) < nlabels) labelcol<-rep(labelcol,length.out=nlabels)
if(length(labelbg) < nlabels) labelbg<-rep(labelbg,length.out=nlabels)
if(length(border) < nlabels) border<-rep(border,length.out=nlabels)
if(length(pointercol) < nlabels) pointercol<-rep(pointercol,length.out=nlabels)
if(length(pch) < nlabels) pch<-rep(pch,length.out=nlabels)
if(length(col) < nlabels) col<-rep(col,length.out=nlabels)
if(length(bg) < nlabels) bg<-rep(bg,length.out=nlabels)
for(i in 1:nlabels) {
points(x[i],y[i],pch=19,col=flagcol)
labelxy<-locator(1)
if(pointer)
segments(x[i],y[i],labelxy$x,labelxy$y,col=pointercol[i])
boxed.labels(labelxy$x,labelxy$y,labels[i],
col=labelcol[i],bg=labelbg[i],border=border[i])
points(rep(x[i],2),rep(y[i],2),pch=c(19,pch[i]),
col=c("white",col[i]),bg=c(NA,bg[i]))
}
}
plotrix/R/rm.plot2.R 0000744 0001762 0000144 00000001067 14011145766 013766 0 ustar ligges users
raw.means.plot2 <- function(data, col.id, col.offset, col.x, col.value, fun.aggregate = "mean", ... ) {
if(!is.data.frame(data)) stop("data must be a data.frame")
columns <- c(col.id, col.offset, col.x, col.value)
if (any(!(columns %in% colnames(data)))) stop("column not matching the data")
formula.agg <- as.formula(paste(col.value, "~", col.id, "+", col.offset, "+", col.x))
d.new <- aggregate(formula.agg, data = data, FUN = fun.aggregate)
raw.means.plot(d.new, col.offset = col.offset, col.x = col.x, col.value = col.value, ...)
}
plotrix/R/getYmult.R 0000644 0001762 0000144 00000000435 14011145766 014120 0 ustar ligges users getYmult<-function() {
if(dev.cur() == 1) {
warning("No graphics device open.")
ymult<-1
}
else {
# get the plot aspect ratio
xyasp<-par("pin")
# get the plot coordinate ratio
xycr<-diff(par("usr"))[c(1,3)]
ymult<-xyasp[1]/xyasp[2]*xycr[2]/xycr[1]
}
return(ymult)
}
plotrix/R/diamondplot.R 0000755 0001762 0000144 00000003340 14011145766 014621 0 ustar ligges users diamondplot<-function(x, bg=gray(0.6), col=rainbow,name="", ...) {
if(!is.data.frame(x)) stop("Argument has to be a data frame")
## read original graphical parms
opar<-par(no.readonly = TRUE)
## set background
par(bg=bg)
prop<-0.8
scale<-5
## define aux. functions
## degrees to radiants
deg2rad<-function(alfa) {
(alfa*pi)/180
}
## normalize data w.r.t. maximum
normalizza<-function(x){
x/max(x)
}
## find points' coordinates
coord<-function(x, prop=17) {
n<-length(x)
alfa<-rep(NA,n)
for (i in 1:n) {
alfa[i]<-360/n*i
}
c.x<-sin(deg2rad(alfa))*x*prop
c.y<-cos(deg2rad(alfa))*x*prop
list(x=c.x,y=c.y)
}
## plot n segments originating from the origin(!)
segmenti<-function(n, prop=1, labels=NULL,scale=5) {
plot(0,0,axes=FALSE,xlab="",ylab="",main=name,...)
for(i in 1:n) {
alfa<-360/n*i
x1<-c(0,sin(deg2rad(alfa))*prop)
y1<-c(0,cos(deg2rad(alfa))*prop)
polygon(x1,y1)
text(sin(deg2rad(alfa)),cos(deg2rad(alfa)),labels[i],cex=0.8)
}
for (i in 1:n) {
alfa<-360/n*i
for( j in 1:scale) {
xa<-(sin(deg2rad(alfa))*(1/scale)*j*prop)
ya<-(cos(deg2rad(alfa))*(1/scale)*j*prop)
points(xa,ya,pch=19)
et<-round((1/scale)*j*17)
text(sin(deg2rad(0))+0.1,cos(deg2rad(0))*(1/scale)*j*prop,et,cex=0.8)
}
}
}
n<-dim(x)[[1]]
k<-dim(x)[[2]]
segmenti(n, prop=prop, labels=rownames(x))
for (j in 1:k) {
polygon(coord(normalizza(x[,j]), prop=prop), lty=j, border=col(k)[j])
}
legend(-1.05,1.05,legend=dimnames(x)[[2]],lty=1:k,col=col(k),cex=0.8)
## ripristinate original graph parms
par(opar)
}
plotrix/R/weighted.hist.R 0000755 0001762 0000144 00000004725 14011145766 015065 0 ustar ligges users get.breaks<-function (x, breaks) {
if (is.character(breaks))
nbreaks <- do.call(paste("nclass", breaks, sep = ".",
collapse = ""), list(x))
if (is.numeric(breaks)) {
if (length(breaks) == 1) {
nbreaks <- breaks
}
else return(breaks)
}
breakinc <- diff(range(x))/nbreaks
breaks <- c(min(x), rep(breakinc, nbreaks))
breaks <- cumsum(breaks)
return(breaks)
}
weighted.hist<-function (x, w, breaks = "Sturges", col = NULL, plot = TRUE,
freq = TRUE, ylim = NA, ylab = NULL, xaxis = TRUE, ...) {
if (missing(x))
stop("Usage: weighted.hist(x,...) vector of values x required")
if (missing(w))
w <- rep(1, length(x))
breaks <- get.breaks(x, breaks)
width <- diff(breaks)
diffx <- diff(range(x))
equidist <- sum(width - width[1]) < diffx/1000
nbreaks <- length(breaks) - 1
lastbreak <- breaks[nbreaks + 1]
breaks[nbreaks + 1] <- breaks[nbreaks + 1] + diffx/1000
if (diff(range(breaks)) < diffx)
warning("Not all values will be included in the histogram")
counts <- rep(0, nbreaks)
for (bin in 1:nbreaks) counts[bin] <- sum(w[x >= breaks[bin] &
x < breaks[bin + 1]])
density <- counts/sum(counts)
if (freq) {
if (is.null(ylab))
ylab <- "Frequency"
heights <- counts
if (!equidist)
warning("Areas will not relate to frequencies")
}
else {
if (!equidist) {
heights <- density * mean(width)/width
heights <- heights/sum(heights)
}
else heights <- density
if (is.null(ylab))
ylab <- "Density"
}
if (plot) {
if (is.null(col))
col <- par("bg")
if (is.na(ylim))
ylim <- c(0, 1.1 * max(heights, na.rm = TRUE))
mids <- barplot(heights, width = width, col = col, space = 0,
ylim = ylim, ylab = ylab, ...)
tickpos <- c(mids - width/2, mids[length(mids)] + width[length(width)]/2)
if (xaxis)
axis(1, at = tickpos, labels = signif(c(breaks[1:nbreaks],
lastbreak), 3))
}
else mids <- breaks[-length(breaks)] + width/2
invisible(list(breaks = breaks, counts = counts, density = density,
mids = mids, xname = deparse(substitute(x)), equidist = equidist))
}
plotrix/R/corner.label.R 0000755 0001762 0000144 00000001162 14011145766 014655 0 ustar ligges users corner.label<-function(label=NULL,x=-1,y=1,xoff=NA,yoff=NA,figcorner=FALSE,...) {
if(is.na(xoff)) xoff<-strwidth("m")/2
if(is.na(yoff)) yoff<-strheight("m")/2
par.usr<-par("usr")
xpos<-par.usr[(3+x)/2]
ypos<-par.usr[(3+y)/2+2]
if(figcorner) {
par.pin<-par("pin")
xplotrange<-par.usr[2]-par.usr[1]
yplotrange<-par.usr[4]-par.usr[3]
par.mai<-par("mai")
xmar<-xplotrange*par.mai[3+x]/par.pin[1]
ymar<-yplotrange*par.mai[2+y]/par.pin[2]
xpos<-xpos+x*xmar
ypos<-ypos+y*ymar
}
if(!is.null(label)) {
text(xpos-x*xoff,ypos-y*yoff,label,adj=c((1+x)/2,(1+y)/2),xpd=TRUE,...)
}
return(list(x=xpos,y=ypos))
}
plotrix/R/color.id.R 0000755 0001762 0000144 00000000253 14011145766 014020 0 ustar ligges users color.id<-function(col) {
c2 <- col2rgb(col)
coltab <- col2rgb(colors())
cdist <- apply(coltab, 2, function(z) sum((z - c2)^2))
colors()[which(cdist == min(cdist))]
}
plotrix/R/thigmophobe.labels.R 0000644 0001762 0000144 00000001113 14011145766 016046 0 ustar ligges users thigmophobe.labels<-function(x,y,labels=NULL,text.pos=NULL,...) {
if(missing(x)) stop("Usage: thigmophobe.labels(x,y,labels=1:length(x))")
lenx<-length(x)
if(missing(y)) {
if(is.list(x) && lenx >= 2) {
y<-x[[2]]
x<-x[[1]]
}
else stop("if y is missing, x must be a list with at least 2 elements")
}
validxy<-!(is.na(x) | is.na(y))
if(is.null(labels)) labels<-1:lenx
if(is.null(text.pos)) {
if(lenx > 1) text.pos<-thigmophobe(x[validxy],y[validxy])
else text.pos<-3
}
par(xpd=TRUE)
text(x[validxy],y[validxy],labels[validxy],pos=text.pos,...)
par(xpd = FALSE)
}
plotrix/R/ladderplot.default.R 0000755 0001762 0000144 00000003013 14011145766 016061 0 ustar ligges users ladderplot.default <-
function(x, scale=FALSE, col=1, pch=19, lty=1, xlim=c(0.5, ncol(x)+0.5), ylim=range(x), vertical = TRUE, ordered=FALSE, ...)
{
x <- as.data.frame(x)
if (scale)
x <- apply(x, 2, function(x) (x - min(x, na.rm = TRUE))/(max(x,
na.rm = TRUE) - min(x, na.rm = TRUE)))
if (NCOL(x) < 2)
stop("'x' must have at least 2 columns")
nr <- nrow(x)
if (length(col) < nr)
col <- rep(col, nr)[1:nr]
if (length(pch) < nr)
pch <- rep(pch, nr)[1:nr]
if (length(lty) < nr)
lty <- rep(lty, nr)[1:nr]
if (ordered)
x <- x[,order(colnames(x))]
y <- data.frame(values=array(unlist(x)),
ind=factor(rep(1:ncol(x), each=nrow(x)), labels=colnames(x)))
id <- match(colnames(x),levels(y$ind))
if (vertical) {
with(y, stripchart(values ~ ind, pch=pch, ylim=ylim, xlim=xlim, vertical=vertical, col="white", ...))
lapply(1:ncol(x), function(i) points(cbind(rep(i,nr), x[,id[i]]), col=col, pch=pch))
lapply(1:nr, function(i) lines(cbind(id, as.matrix(x)[i,]), col=col[i], lty=lty[i]))
} else {
tmp <- xlim
xlim <- ylim
ylim <- tmp
with(y, stripchart(values ~ ind, pch=pch, ylim=ylim, xlim=xlim, vertical=vertical, col="white", ...))
lapply(1:ncol(x), function(i) points(cbind(x[,id[i]], rep(i,nr)), col=col, pch=pch))
lapply(1:nr, function(i) lines(cbind(as.matrix(x)[i,], id), col=col[i], lty=lty[i]))
}
invisible(NULL)
}
plotrix/R/symbolbox.R 0000755 0001762 0000144 00000001751 14011145766 014331 0 ustar ligges users symbolbox<-function(x1,y1,x2,y2,tot,relw=0.5,fg=par("fg"),bg=par("bg"),
box=TRUE,debug=TRUE,...) {
if(debug) cat("symbolbox:",x1,y1,x2,y2,tot,"\n")
x <- c(x1,x2)
y <- c(y1,y2)
if (x2 < x1) x<-rev(x)
if (y2 < y1) y<-rev(y)
pin<-par("pin")
usr<-par("usr")
usr.pin<-diff(par("usr"))[c(1,3)]/par("pin")
dx<-diff(x)/usr.pin[1]
dy<-diff(y)/usr.pin[2]
area<-dx*dy
m<-dx*sqrt(tot/area)
n<-dy*sqrt(tot/area)
rm<-max(round(m),1)
rn<-max(round(n),1)
while(rm*rn < tot) {
if((dx*sqrt(tot/area)-m) > (dy*sqrt(tot/area)-n)) {
rm <- rm + 1
}
else {
rn <- rn + 1
}
}
m<-rm
n<-rn
if(debug) cat("symbolbox:",dx,dy,m,n,rm,rn,tot,"\n")
r<-dx/m*relw/2
dx<-dx/m*usr.pin[1]
dy<-dy/n*usr.pin[2]
mat<-matrix(1:(m*n),nrow=m,ncol=n)
xpos<-x[1]+(row(mat)[mat <= tot] - 0.5) * dx
ypos<-y[1]+(col(mat)[mat <= tot] - 0.5) * dy
symbols(xpos,ypos,rep(1,tot),bg=bg,fg=fg,add=TRUE,inches=r)
if(box)
polygon(x[c(1,1,2,2,1)],y[c(1,2,2,1,1)],border=fg,...)
}
plotrix/R/thigmophobe.R 0000755 0001762 0000144 00000002371 14011145766 014617 0 ustar ligges users # function contributed by Bill Venables as a replacement for thigmophobe
thigmophobe <- function (x, y = NULL, names = seq_along(z),
xlog = par("xlog"), ylog = par("ylog"),
usr = par("usr"), pin = par("pin"),
eps = .Machine$double.eps, pi = base::pi) {
# convert separete x and y coordinates to a two element list
xy <- grDevices::xy.coords(x, y, recycle = TRUE)
z <- with(xy, {
x <- ((if(xlog) log(x) else x) - usr[1])/diff(usr[1:2])*pin[1]
y <- ((if(ylog) log(y) else y) - usr[3])/diff(usr[3:4])*pin[2]
complex(real = x, imaginary = y)
})
# calculate the matrix of distances
xydist <- outer(z, z, function(x, y) Mod(x - y))
# remove "self" distances
diag(xydist) <- Inf
# get the indicies of the smallest distances
nearby <- apply(xydist, 2, which.min)
zdiff <- z - z[nearby]
# get the offset away from the nearest point for each label
pos <- findInterval((-pi/4 - Arg(zdiff)) %% (2*pi),
seq(0, 2*pi, by = pi/2), all.inside = TRUE)
# stagger the offsets for points with essentially zero differences
if(any(k <- Mod(zdiff) <= eps)) {
for(k in which(k)) {
pos[sort(c(k, nearby[k]))] <- c(1,3)
}
}
names(pos)<-names
return(pos)
}
plotrix/R/triax.R 0000755 0001762 0000144 00000017101 14011145766 013436 0 ustar ligges users get.triprop<-function(use.percentages=FALSE,cnames=c("1st","2nd","3rd")) {
cat("Enter the label and ")
cat(ifelse(use.percentages,"percentages ","proportions "))
cat("of",cnames[1],cnames[2],"and",cnames[3],"for each observation.\n")
cat("Enter a blank observation label to end.\n")
nextlabel<-"dummy"
nextprop<-0
proplabels<-NA
prop1<-NA
prop2<-NA
prop3<-NA
nprop<-0
totprop<-ifelse(use.percentages,100,1)
tolerance<-ifelse(use.percentages,1,0.01)
while(nchar(nextlabel)) {
nextlabel<-readline("Observation label - ")
if(nchar(nextlabel)) {
if(is.na(proplabels[1])) proplabels<-nextlabel
else proplabels<-c(proplabels,nextlabel)
cat(cnames[1],"- ")
nextprop<-as.numeric(readline())
if(is.na(prop1[1])) prop1<-nextprop
else prop1<-c(prop1,nextprop)
cat(cnames[2],"- ")
nextprop<-as.numeric(readline())
if(is.na(prop2[1])) prop2<-nextprop
else prop2<-c(prop2,nextprop)
cat(cnames[3],"- ")
nextprop<-as.numeric(readline())
if(is.na(prop3[1])) prop3<-nextprop
else prop3<-c(prop3,nextprop)
nprop<-nprop+1
}
sumprop<-prop1[nprop]+prop2[nprop]+prop3[nprop]
if(abs(totprop-sumprop) > tolerance)
cat("Warning - sum not equal to",totprop,"\n")
}
triprop<-cbind(prop1,prop2,prop3)
rownames(triprop)<-proplabels
colnames(triprop)<-cnames
return(triprop)
}
triax.abline<-function(b=NULL,r=NULL,l=NULL,col=par("col"),lty=par("lty"),
cc.axes=FALSE) {
sin60<-sin(pi/3)
if(!is.null(b)) {
if(any(b>1)) b<-b/100
if(cc.axes) {
bx2<-b+0.5*(1-b)
by2<-sin60*(1-b)
segments(b,0,bx2,by2,col=col,lty=lty)
}
else {
bx2<-0.5*(1-b)
by2<-sin60*(1-b)
segments(1-b,0,bx2,by2,col=col,lty=lty)
}
}
if(!is.null(r)) {
if(any(r>1)) r<-r/100
if(cc.axes) {
rx1<-0.5*r
ry1<-sin60*r
rx2<-1-r*0.5
segments(rx1,ry1,rx2,ry1,col=col,lty=lty)
}
else {
rx1<-0.5*(r+1)
ry1<-sin60*(1-r)
rx2<-1-r
segments(rx1,ry1,r,0,col=col,lty=lty)
}
}
if(!is.null(l)) {
if(any(l>1)) l<-l/100
if(cc.axes) {
lx1<-0.5-l*0.5
lx2<-1-l
ly<-sin60*(1-l)
segments(lx1,ly,lx2,0,col=col,lty=lty)
}
else {
lx1<-l*0.5
ly<-l*sin60
segments(lx1,ly,1-lx1,ly,col=col,lty=lty)
}
}
}
triax.points<-function(x,show.legend=FALSE,
label.points=FALSE,point.labels=NULL,col.symbols=par("fg"),
pch=par("pch"),bg.symbols=par("bg"),cc.axes=FALSE,...) {
if(dev.cur() == 1)
stop("Cannot add points unless the triax.frame has been drawn")
if(missing(x))
stop("Usage: triax.points(x,...)\n\twhere x is a 3 column array of proportions or percentages")
if(!is.matrix(x) && !is.data.frame(x))
stop("x must be a matrix or data frame with at least 3 columns and one row.")
if(any(x > 1) || any(x < 0)) {
if(any(x < 0))
stop("All proportions must be between zero and one.")
if(any(x > 100))
stop("All percentages must be between zero and 100.")
# convert percentages to proportions
x<-x/100
}
if(any(abs(rowSums(x)-1) > 0.01))
warning("At least one set of proportions does not equal one.")
sin60<-sin(pi/3)
if(cc.axes) {
ypos<-x[,3]*sin60
xpos<-x[,1]+x[,3]*0.5
}
else {
ypos<-x[,3]*sin60
xpos<-1-(x[,1]+x[,3]*0.5)
}
nobs<-dim(x)[1]
points(x=xpos,y=ypos,pch=pch,col=col.symbols,bg=bg.symbols,type="p",...)
if(is.null(point.labels)) point.labels<-rownames(x)
if(label.points) thigmophobe.labels(xpos,ypos,point.labels)
if(show.legend) {
legend(0.2,0.7,legend=point.labels,pch=pch,col=col.symbols,
xjust=1,yjust=0)
}
invisible(list(x=xpos,y=ypos))
}
triax.frame<-function(at=seq(0.1,0.9,by=0.1),axis.labels=NULL,
tick.labels=NULL,col.axis="black",cex.axis=1,cex.ticks=1,
align.labels=TRUE,show.grid=FALSE,col.grid="gray",lty.grid=par("lty"),
cc.axes=FALSE) {
sin60<-sin(pi/3)
# bottom ticks
bx1<-at
bx2<-bx1+0.01-0.02*cc.axes
by1<-rep(0,9)
if(cc.axes) by2<-rep(-0.02*sin(2*pi/3),9)
else by2<-rep(-0.02*sin60,9)
# left ticks
ly1<-at*sin60
lx1<-bx1*0.5
lx2<-lx1-0.02+0.013*cc.axes
if(cc.axes) ly2<-ly1+rep(0.014*sin60,9)
else ly2<-ly1
# right ticks
rx1<-at*0.5+0.5
rx2<-rx1+0.01
ry1<-rev(ly1)
if(cc.axes) ry2<-ry1
else ry2<-rev(ly2)+0.02*sin60
if(show.grid) {
par(fg=col.grid)
segments(bx1,by1,lx1,ly1,lty=lty.grid)
segments(lx1,ly1,rev(rx1),rev(ry1),lty=lty.grid)
segments(rx1,ry1,bx1,by1,lty=lty.grid)
}
par(fg=col.axis,xpd=TRUE)
if(is.null(tick.labels)) {
if(cc.axes) tick.labels<-list(l=rev(at),r=rev(at),b=rev(at))
else tick.labels<-list(l=at,r=at,b=at)
}
else {
if(cc.axes) {
tick.labels$l<-rev(tick.labels$l)
tick.labels$r<-rev(tick.labels$r)
tick.labels$b<-rev(tick.labels$b)
}
}
# left axis label
if(align.labels) par(srt=60)
text(0.13,0.5,axis.labels[3-cc.axes],adj=0.5,cex=cex.axis)
# left axis tick labels
if(cc.axes) {
par(srt=300)
xoffset<-0.02
yoffset<-0.04
}
else {
par(srt=0)
xoffset<-0.05
yoffset<-0
}
text(lx1-xoffset,ly1+yoffset,tick.labels$l,cex=cex.ticks)
# right axis label
if(align.labels) {
par(srt=300)
label.adj<-0.5
}
else {
par(srt=0)
label.adj<-0
}
text(0.86,0.52,axis.labels[2+cc.axes],adj=label.adj,cex=cex.axis)
# right axis tick labels
if(cc.axes) {
par(srt=0)
xoffset<-0.033
yoffset<-0.005
}
else {
par(srt=60)
xoffset<-0.015
yoffset<-0.045
}
text(rx2+xoffset,ry1+yoffset,tick.labels$r,cex=cex.ticks)
# bottom axis tick labels
if(cc.axes) {
par(srt=60)
xoffset<- -0.03
}
else {
par(srt=300)
xoffset<-0.03
}
text(bx1+xoffset,by1-0.05,rev(tick.labels$b),cex=cex.ticks)
# bottom axis label
par(srt=0)
text(0.5,-0.14,axis.labels[1],cex=cex.axis)
# draw the triangle and ticks
x1<-c(0,0,0.5)
x2<-c(1,0.5,1)
y1<-c(0,0,sin60)
y2<-c(0,sin60,0)
par(fg=col.axis)
segments(x1,y1,x2,y2)
# bottom ticks
segments(bx1,by1,bx2,by2)
# left ticks
segments(lx1,ly1,lx2,ly2)
# right ticks
segments(rx1,ry1,rx2,ry2)
}
triax.fill<-function(col) {
nrows<-length(col)
sin60<-sin(pi/3)
rowlen<-1
xinc<-0.5/nrows
yinc<-sin60/nrows
for(trirow in 1:nrows) {
startx<-0.5-xinc*(trirow-1)
starty<-sin60-trirow*yinc
dir<-1
for(triangle in 1:rowlen) {
polygon(c(startx-xinc,startx,startx+xinc),
c(starty,starty+yinc*dir,starty),border=NA,
col=col[[trirow]][triangle])
startx<-startx+xinc
starty<-starty+yinc*dir
dir<--dir
}
rowlen<-rowlen+2
}
}
triax.plot<-function (x=NULL,main="",at=seq(0.1,0.9,by=0.1),
axis.labels=NULL,tick.labels=NULL,col.axis="black",
cex.axis=1,cex.ticks=1,align.labels=TRUE,
show.grid=FALSE,col.grid="gray",lty.grid=par("lty"),cc.axes=FALSE,
show.legend=FALSE,label.points=FALSE,point.labels=NULL,
col.symbols="black",pch=par("pch"),mar=c(5,2,4,2),no.add=TRUE,...) {
oldpar<-par("fg","pty","mar","srt","xpd")
par(xpd=TRUE)
if(is.null(axis.labels)) axis.labels<-colnames(x)[1:3]
par(pty="s",mar=mar)
plot(0.5,type="n",axes=FALSE,xlim=c(0,1),ylim=c(0,1),main=main,
xlab="",ylab="")
triax.frame(at=at,axis.labels=axis.labels,
tick.labels=tick.labels,col.axis=col.axis,cex.axis=cex.axis,
cex.ticks=cex.ticks,align.labels=align.labels,show.grid=show.grid,
col.grid=col.grid,lty.grid=lty.grid,cc.axes=cc.axes)
if(is.null(x)) xypos <- NULL
else
xypos<-triax.points(x,show.legend=show.legend,
label.points=label.points,
point.labels=point.labels,
col.symbols=col.symbols,pch=pch,cc.axes=cc.axes,...)
if(no.add) par(oldpar)
invisible(list(xypos=xypos,oldpar=oldpar))
}
plotrix/R/ehplot.R 0000644 0001762 0000144 00000004036 14011145766 013602 0 ustar ligges users ehplot <-
function (data, groups, intervals = 50, offset = 0.1, log = FALSE,
median = TRUE, box = FALSE, boxborder = "grey50", xlab = "groups",
ylab = "values", col = "black", add = FALSE, sort = TRUE,
...)
{
stopifnot(length(data) == length(groups), is.numeric(data),
intervals > 0, offset < 0.4)
grps <- split(data, groups, drop = TRUE)
if (sort) {
grouporder <- 1:length(grps)
}
else {
grouporder <- rank(unique(groups))
}
dr <- range(data, finite = TRUE)
if (log) {
seps <- dr[1] * exp((0:intervals) * log(dr[2]/dr[1])/intervals)
}
else {
seps <- (0:intervals) * (diff(dr)/intervals) + dr[1]
}
inc <- rep(1:(0.4/offset), each = 2)
xshift <- list(even = c((inc - 0.5) * offset * (-1)^(1:length(inc))),
odd = c(0, inc * offset * (-1)^(1:length(inc))))
pnts_a <- list()
for (i in 1:length(grps)) {
tgrp <- grps[[grouporder[i]]]
histo <- hist(tgrp, breaks = seps, plot = FALSE)$counts
ixof <- unlist(sapply(histo, function(j) {
rep(xshift[[j%%2 + 1]], length.out = j)
}))
pnts_a[[i]] <- i + ixof[rank(tgrp, ties.method = "first")]
if (anyDuplicated(na.omit(cbind(tgrp, pnts_a[[i]]))))
warning("Some points are overplotted in group ",
names(grps)[grouporder[i]], ". Please consider using a lower offset-value.")
}
if (!add) {
plot(data, xlim = c(0.5, length(grps) + 0.5), xaxt = "n",
type = "n", xlab = xlab, ylab = ylab, log = ifelse(log,
"y", ""), ...)
axis(1, at = grouporder, labels = names(grps), ...)
}
if (box)
boxplot(data ~ groups, border = boxborder, at = grouporder,
add = TRUE, axes = FALSE, outline = FALSE)
points(unsplit(pnts_a[grouporder], groups, drop = TRUE),
data, col = col, ...)
if (median)
lines(rep(grouporder, each = 3) + c(-0.4, 0.4, NA), rep(sapply(grps,
median, na.rm = TRUE), each = 3) + c(0, 0, NA), lwd = 3)
}
plotrix/R/makeIntersectList.R 0000755 0001762 0000144 00000004773 14011145766 015754 0 ustar ligges users pasteCols<-function(x,sep="") {
pastestring<-paste("list(",paste("x","[",1:dim(x)[1],",]",
sep="",collapse=","),")",sep="")
return(do.call(paste,c(eval(parse(text = pastestring)),sep=sep)))
}
# converts a two column matrix of object identifiers [,1] and attributes [,2]
# into a data frame of TRUE/FALSE values where each row is an object and
# each column is an attribute
categoryReshape<-function(x) {
dimx<-dim(x)
if(is.null(dimx) || dimx[2]==1)
stop("Can only reshape a matrix or data frame with at least two columns")
row_values<-sort(unique(x[,1]))
column_values<-sort(unique(x[,2]))
newx<-
as.data.frame(matrix(0,nrow=length(row_values),ncol=length(column_values)))
for(row in 1:dimx[1]) {
row_index<-which(row_values %in% x[row,1])
column_index<-which(column_values %in% x[row,2])
newx[row_index,column_index]<-1
}
names(newx)<-column_values
return(newx)
}
# makes an intersectList object from a matrix or data frame of TRUE/FALSE
# values where each row represents an object and each column an attribute
# TRUE indicates that the object has that attribute, FALSE that it does not
# add a "weight" vector that allows a count of objects to be read directly
makeIntersectList<-function(x,xnames=NULL,sep="+") {
# If any entries in x are not 1/0 OR TRUE/FALSE, assume that x
# is a two column matrix of object identifiers [,1] and attributes [,2]
if(any(!(x %in% c(TRUE,FALSE)))) x<-categoryReshape(x)
if(is.null(xnames)) xnames <- colnames(x)
dimx<-dim(x)
if(is.null(xnames)) xnames<-LETTERS[1:dimx[2]]
intersectList<-vector("list",dimx[2]+2)
for(intersect in 1:dimx[2])
intersectList[[1]][intersect]<-sum(rowSums(x)==1 & x[,intersect])
names(intersectList[[1]])<-xnames
for(comb in 2:dimx[2]) {
nn<-choose(dimx[2],comb)
intersectList[[comb]]<-rep(0,nn)
currentnames<-
names(intersectList[[comb]])<-pasteCols(combn(xnames,comb),sep)
currentcombs<-combn(1:dimx[2],comb,simplify=TRUE)
for(intersect in 1:nn) {
combvec<-rep(0,dimx[2])
combvec[currentcombs[,intersect]]<-1
intersectList[[comb]][intersect]<-
sum(colSums(apply(x,1,"==",combvec))==dimx[2])
}
}
intersectList[[dimx[2]+1]]<-dimx[1]
names(intersectList[[dimx[2] + 1]])<-"Total"
intersectList[[dimx[2]+2]]<-xnames
names(intersectList[[dimx[2] + 2]])<-"attributes"
# drop any empty intersection levels
for(comb in dimx[2]:1)
if(sum(intersectList[[comb]])==0) intersectList[[comb]]<-NULL
class(intersectList)<-"intersectList"
return(intersectList)
}
plotrix/R/election.R 0000644 0001762 0000144 00000001305 14011145766 014105 0 ustar ligges users seats<-function (N, M, r0 = 2.5) {
radii <- seq(r0, 1, len = M)
counts <- numeric(M)
pts <- do.call(rbind, lapply(1:M,
function(i) {
counts[i] <<- round(N * radii[i]/sum(radii[i:M]))
theta <- seq(0, pi, len = counts[i])
N <<- N - counts[i]
data.frame(x = radii[i] * cos(theta), y = radii[i] *
sin(theta), r = i, theta = theta)
}
)
)
pts <- pts[order(-pts$theta, -pts$r), ]
pts
}
election<-function (seats, result, formula,
colours = sample(rainbow(length(counts)))) {
result <- model.frame(formula, result)
counts <- result[, 2]
stopifnot(sum(counts) == nrow(seats))
seats$party <- factor(rep(result[, 1], counts))
seats$colour <- colours[as.numeric(seats$party)]
seats
}
plotrix/R/emptyspace.R 0000755 0001762 0000144 00000003266 14011145766 014470 0 ustar ligges users emptyspace<-function(x,y=NULL) {
xlim<-par("usr")[1:2]
ylim<-par("usr")[3:4]
if(is.null(y)) {
if(is.list(x)) {
# trust me, I'm a list
y<-as.vector(x[[2]])
x<-as.vector(x[[1]])
}
else stop("both x and y values must be supplied")
}
xyna<-which(is.na(x) | is.na(y))
if(any(xyna)) {
# get rid of any NAs
x<-x[-xyna]
y<-y[-xyna]
}
# check for negative values and offset them out
xoffset<-yoffset<-0
if(any(x < 0)) {
xoffset<-min(x)
x<-x-xoffset
xlim<-xlim-xoffset
}
if(any(y < 0)) {
yoffset<-min(y)
y<-y-yoffset
ylim<-ylim-yoffset
}
# here begins Ray Brownrigg's code
ox<-order(x)
x<-x[ox]
y<-y[ox]
x<-c(xlim[1],x,xlim[2])
y<-c(ylim[1],y,ylim[2])
omaxa<-0
halfxspan<-diff(xlim)/2
halfyspan<-diff(ylim)/2
# added braces here for clarity
for(i in 1:(length(x)-1)) {
for(j in (i+1):length(x)) {
x1<-x[i]
x2<-x[j]
XX<-x2 - x1
# if(XX > halfxspan) break
yy<-c(ylim[1],y[(i+1):(j-1)],ylim[2])
oyy<-order(yy)
yy<-yy[oyy]
dyy<-diff(yy)
# whichdyy<-(dyy <= halfyspan) & (dyy >= 0.5*XX) & (dyy <= 2*XX)
# the next line fixes the problem with very large empty spaces
whichdyy<-(dyy >= 0.5*XX) & (dyy <= 2*XX)
wy1<-yy[whichdyy]
if(length(wy1) > 0) {
wy2<-yy[(1:length(dyy))[whichdyy]+1]
k<-which.max(dyy[whichdyy])
maxa<-(x2-x1)*(wy2[k]-wy1[k])
if(maxa > omaxa) {
omaxa<-maxa
mx1<-x1
mx2<-x2
my1<-wy1[k]
my2<-wy2[k]
}
}
}
}
# if offsets were used, remove them from the final values
if(xoffset < 0) {
mx1<-mx1+xoffset
mx2<-mx2+xoffset
}
if(yoffset < 0) {
my1<-my1+yoffset
my2<-my2+yoffset
}
# return the center of the rectangle
return(list(x=(mx1+mx2)/2,y=(my1+my2)/2))
}
plotrix/R/maxEmptyRect.R 0000644 0001762 0000144 00000003117 14011145766 014730 0 ustar ligges users # function to find the largest rectangle not containing any of the points
# specified by x and y
# adapted by Hans Borchers from
# A. Naamad, D. T. Lee, and W.-L. Hsu (1984). On the Maximum Empty
# Rectangle Problem. Discrete Applied Mathematics, Vol. 8, pp. 267--277.
maxEmptyRect <- function(ax, ay, x, y) {
n <- length(x)
d <- sort(c(ax, x))
D <- diff(d)
m <- which.max(D)
# check vertical slices
mgap <- D[m]
maxr <- mgap * (ay[2] - ay[1])
maxR <- c(d[m], ay[1], d[m+1], ay[2])
o <- order(y)
X <- x[o]; Y <- y[o]
for (i in 1:n) {
tl <- ax[1]; tr <- ax[2]
if (i < n) {
for (j in (i+1):n) {
if (X[j] > tl && X[j] < tr) {
# check horizontal slices (j == i+1)
# and (all) rectangles above (X[i], Y[i])
area <- (tr-tl)*(Y[j]-Y[i])
if (area > maxr) {
maxr <- area
maxR <- c(tl, Y[i], tr, Y[j])
}
if (X[j] > X[i]) tr <- X[j]
else tl <- X[j]
}
}
}
# check open rectangles above (X[i], Y[i])
area <- (tr-tl)*(ay[2]-Y[i])
if (area > maxr) {
maxr <- area
maxR <- c(tl, Y[i], tr, ay[2])
}
}
for (i in 1:n) {
# check open rectangles above (X[i], Y[i])
ri <- min(ax[2], X[Y > Y[i] & X > X[i]])
li <- max(ax[1], X[Y > Y[i] & X < X[i]])
area <- (ri-li)*(ay[2]-Y[i])
if (area > maxr) {
maxr <- area
maxR <- c(li, Y[i], ri, ay[2])
}
# check open rectangles below (X[i], Y[i])
ri <- min(ax[2], X[Y < Y[i] & X > X[i]])
li <- max(ax[1], X[Y < Y[i] & X < X[i]])
area <- (ri-li)*(Y[i]-ay[1])
if (area > maxr) {
maxr <- area
maxR <- c(li, ay[1], ri, Y[i])
}
}
return(list(area = maxr, rect = maxR))
}
plotrix/R/sizeplot.R 0000755 0001762 0000144 00000001221 14011145766 014154 0 ustar ligges users sizeplot<-function(x,y,scale=1,pow=0.5,powscale=TRUE,size=c(1,4),add=FALSE,...) {
pair <- function(x, y) paste(x, y, sep = "/")
unpair <- function(x) t(sapply(strsplit(x, "/"), as.numeric))
f<-factor(pair(x, y))
n<-table(f)
if(min(n) == max(n)) {
warning("all points repeated equally (why use sizeplot?)")
if(powscale) psize <- rep(length(f), scale)
else psize <- rep(length(f), size[1])
}
else {
if(powscale) psize<-scale*n^pow
else psize<-size[1]+(size[2]-size[1])*((n-min(n))/(max(n)-min(n)))
}
newpts<-unpair(levels(f))
if(!add) plot(newpts[,1],newpts[,2],cex=psize,type="p",...)
else points(newpts[,1],newpts[,2],cex=psize,...)
}
plotrix/R/legendg.R 0000755 0001762 0000144 00000006410 14011145766 013715 0 ustar ligges users legendg<-function (x, y = NULL, legend, fill = NULL, col = par("col"),
border = list("black"), lty, lwd, pch = NULL, angle = 45,
density = NULL, bty = "o", bg = par("bg"), box.lwd = par("lwd"),
box.lty = par("lty"), box.col = par("fg"), pt.bg = NA, cex = 1,
pt.cex = cex, pt.lwd = lwd, pt.space = 1, xjust = 0, yjust = 1,
x.intersp = 1, y.intersp = 1, adj = c(0, 0.5), text.width = NULL,
text.col = par("col"), merge = FALSE, trace = FALSE, plot = TRUE,
ncol = 1, horiz = FALSE, title = NULL, inset = 0, xpd, title.col = text.col) {
if (missing(legend) && !is.null(y)) {
legend <- y
y <- NULL
}
if (is.list(x)) {
y <- x$y
x <- x$x
}
if (is.null(y)) {
if (is.character(x)) {
tablepos <- get.tablepos(x)
x <- tablepos$x
y <- tablepos$y
xjust <- tablepos$xjust
yjust <- tablepos$yjust
}
}
if (!missing(xpd)) {
oldxpd <- par("xpd")
par(xpd = xpd)
}
legend.info <- legend(x = x, y = y, legend = legend, col = par("bg"),
lty = 1, bty = bty, bg = bg, box.lwd = box.lwd, box.lty = box.lty,
box.col = par("fg"), pt.bg = NA, cex = cex, pt.cex = pt.cex,
pt.lwd = pt.lwd, xjust = xjust, yjust = yjust, x.intersp = x.intersp,
y.intersp = y.intersp, adj = adj, text.width = text.width,
text.col = text.col, merge = merge, trace = trace, plot = plot,
ncol = ncol, horiz = horiz, title = title, inset = inset,
title.col = title.col)
if (!is.null(fill)) {
if (length(border) < length(fill))
border <- rep(border, length(fill))
rectheight <- strheight("Q", cex = cex)
if (length(adj) > 1)
yadj <- adj[2]
else yadj <- 0.5
for (nel in 1:length(fill)) {
nrect <- length(fill[[nel]])
rectspace <- (legend.info$text$x[nel] - legend.info$rect$left)
lefts <- cumsum(c(legend.info$rect$left + rectspace *
0.1, rep(0.8 * rectspace/nrect, nrect - 1)))
rights <- lefts + 0.7 * rectspace/nrect
bottoms <- rep(legend.info$text$y[nel] - yadj * rectheight,
nrect)
rect(lefts, bottoms, rights, bottoms + rectheight,
col = fill[[nel]], border = ifelse(is.na(fill[[nel]]),
NA, border[[nel]]))
}
}
if (!is.null(pch)) {
if (!is.list(col)) {
mycol <- pch
if (length(col) < length(mycol[[1]]))
col <- rep(col, length.out = length(mycol[[1]]))
for (nel in 1:length(col)) mycol[[nel]] <- rep(col,
length.out = length(mycol[[nel]]))
}
else mycol <- col
lenpch <- length(pch)
xright <- legend.info$text$x[1] - (legend.info$text$x[1] -
legend.info$rect$left) * 0.15
for (nel in 1:lenpch) {
npch <- length(pch[[nel]])
pchwidth <- strwidth(pch[[nel]]) * pt.space
xpos <- rev((xright + pchwidth/2) - cumsum(pchwidth))
ypos <- rep(legend.info$text$y[nel], npch)
points(xpos, ypos, pch = pch[[nel]], col = mycol[[nel]],
cex = pt.cex)
}
}
if (!missing(xpd))
par(xpd = oldxpd)
invisible(legend.info)
}
plotrix/R/radial.grid.R 0000644 0001762 0000144 00000003246 14105634060 014463 0 ustar ligges users radial.grid<-function(labels=NA,label.pos=NULL,radlab=FALSE,radial.lim=NULL,
start=0,clockwise=FALSE,label.prop=1.1,grid.pos=seq(0.25,1,0.25),
rad.col="gray",grid.col="gray",grid.bg="transparent",show.radial.grid=TRUE,
start.plot=FALSE) {
if(start.plot) {
radial.span<-diff(radial.lim)
plot(0,type="n",xlim=c(-1.2*radial.span,1.2*radial.span),
ylim=c(-1.2*radial.span,1.2*radial.span),xlab="",ylab="",axes=FALSE)
}
par(xpd=TRUE)
if(is.null(label.pos)) label.pos<-seq(0,1.8*pi,length=9)
if(!is.null(labels)) {
if(is.na(labels[1])) labels<-as.character(round(label.pos,2))
}
if(clockwise) label.pos<--label.pos
if(start) label.pos<-label.pos+start
# display the circumferential grid
angles<-seq(0,1.96*pi,by=0.04* pi)
for(i in seq(length(grid.pos),1,by=-1)) {
xpos<-cos(angles)*(grid.pos[i]-radial.lim[1])
ypos<-sin(angles)*(grid.pos[i]-radial.lim[1])
polygon(xpos,ypos,border=grid.col,col=grid.bg)
}
maxlength<-max(grid.pos)-radial.lim[1]
# display the radial grid
if(show.radial.grid) {
xpos<-cos(label.pos)*maxlength
ypos<-sin(label.pos)*maxlength
segments(0,0,xpos,ypos,col=rad.col)
xpos<-cos(label.pos)*maxlength
ypos<-sin(label.pos)*maxlength
}
# display the circumferential labels
if(!is.null(labels)) {
xpos<-cos(label.pos)*maxlength*label.prop
ypos<-sin(label.pos)*maxlength*label.prop
if(radlab) {
for(label in 1:length(labels)) {
labelsrt<-(180*label.pos[label]/pi)+180*
(label.pos[label] > pi/2 && label.pos[label] < 3*pi/2)
text(xpos[label],ypos[label],labels[label],
cex=par("cex.axis"),srt=labelsrt)
}
}
else
boxed.labels(xpos,ypos,labels,ypad=0.7,border=FALSE,cex=par("cex.axis"))
}
par(xpd = FALSE)
}
plotrix/R/joyPlot.R 0000644 0001762 0000144 00000002530 14011145766 013744 0 ustar ligges users joyPlot<-function(x,mar=c(5,4,4,2),newrange=c(0,1),border=NA,fill=NULL,
main="",xlab="",ylab="",xlim=NA,line_labels=names(x),xat=NULL,
xaxlab=NULL) {
oldmar<-par(mar=mar)
nlines<-length(x)
xmin<-min(x[[1]]$x,na.rm=TRUE)
xmax<-max(x[[1]]$x,na.rm=TRUE)
ymax<-max(x[[1]]$y,na.rm=TRUE)
for(i in 2:nlines) {
thisxmin<-min(x[[i]]$x,na.rm=TRUE)
if(thisxmin < xmin) xmin<-thisxmin
thisxmax<-max(x[[i]]$x,na.rm=TRUE)
if(thisxmax < xmax) xmax<-thisxmax
ymax<-c(ymax,max(x[[i]]$y,na.rm=TRUE))
}
if(is.na(xlim[1])) xlim<-c(xmin,xmax)
oaymax<-max(ymax)
if(is.na(border[1])) border<-rainbow(nlines)
else if(length(border) < nlines) border=rep(border,length.out=nlines)
if(!is.null(fill)) if(length(fill) < nlines)
fill<-rep(fill,length.out=nlines)
plot(0,type="n",xlim=xlim,ylim=c(0,nlines+newrange[2]-1),
main=main,xlab=xlab,ylab=ylab,xaxt="n",yaxt="n")
if(is.null(xat)) axis(1)
else {
if(is.null(xaxlab)) xaxlab<-xat
axis(1,at=xat,labels=xaxlab)
}
abline(h=0:(nlines-1),col="lightgray")
if(is.null(line_labels)) line_labels<-1:nlines
axis(2,at=0:(nlines-1)+0.5,labels=line_labels,las=1)
for(i in nlines:1) {
thisrange<-c(newrange[1],newrange[2]*ymax[i]/oaymax)
x[[i]]$y<-rescale(x[[i]]$y,thisrange)+i-1
if(is.null(fill[i])) lines(x[[i]],col=border[i])
else polygon(x[[i]],border=border[i],col=fill[i])
}
box()
par(mar=oldmar)
}
plotrix/R/tab.title.R 0000755 0001762 0000144 00000002406 14011145766 014177 0 ustar ligges users tab.title<-function(label,text.col=par("fg"),tab.col=par("bg"),
border=par("fg"),lwd=par("lwd"),cex=1.5,pad.mult=1.6,radius=0) {
plotin<-par("pin")
marin<-par("mai")
plim<-par("usr")
xmult<-(plim[2]-plim[1])/(plim[4]-plim[3])*plotin[2]/plotin[1]
plim[3]<-plim[4]
plim[4]<-plim[3]+((plim[2]-plim[1])/xmult)*marin[3]/plotin[2]
oldcex<-par("cex")
par(cex=cex)
tabtop<-plim[3]+strheight(label)*pad.mult
oldxlog<-par("xlog")
oldylog<-par("ylog")
par(xlog=FALSE,ylog=FALSE)
if(radius == 0) {
tabx<-c(plim[1],plim[1],plim[2],plim[2])
taby<-c(plim[3],tabtop,tabtop,plim[3])
}
else {
xradius<-radius*(tabtop-plim[3])*xmult
xcurve1<-xradius*cos(seq(0,pi/2,length.out=20))
xcurve2<-xradius*cos(seq(pi/2,pi,length.out=20))
tabx<-c(plim[2],
(plim[2]-xradius)+xcurve1,
(plim[1]+xradius)+xcurve2,
plim[1])
yradius<-radius*(tabtop-plim[3])
ycurve1<-yradius*sin(seq(0,pi/2,length.out=20))
ycurve2<-yradius*sin(seq(pi/2,pi,length.out=20))
taby<-c(plim[3],
tabtop-yradius+ycurve1,
tabtop-yradius+ycurve2,
plim[3])
}
par(xpd=TRUE)
polygon(tabx,taby,border=border,col=tab.col,lwd=lwd)
text((plim[1]+plim[2])/2,(plim[3]+tabtop)/2,label,
col=text.col)
par(xpd=FALSE,xlog=oldxlog,ylog=oldylog,cex=oldcex)
}
plotrix/R/barlabels.R 0000644 0001762 0000144 00000001640 14011145766 014234 0 ustar ligges users barlabels<-function(xpos,ypos,labels=NULL,cex=1,prop=0.5,miny=0,offset=0,
nobox=FALSE,...) {
if(is.data.frame(ypos)) ypos<-as.matrix(ypos)
if(is.null(labels)) labels<-ypos
# usually don't want to display zero labels
display<-ypos > miny
if(is.matrix(ypos)) {
# prop is within the scope of the current environment
cumcenter<-function(x,pos) return(cumsum(x)-x*prop)
stacked<-length(xpos) < length(ypos)
if(stacked) {
# replicate the x positions one by one, but the offsets group by group
xpos<-rep(xpos,each=length(ypos)/length(xpos))+
rep(c(-offset,offset),length(ypos)/(2*length(xpos)))
ypos<-apply(ypos,2,cumcenter)
}
else ypos<-ypos*prop
}
else ypos<-ypos*prop
# allow labels to extend beyond the plot area
par(xpd=TRUE)
if(nobox) text(xpos[display],ypos[display],labels[display],cex=cex,...)
else boxed.labels(xpos[display],ypos[display],labels[display],cex=cex,...)
par(xpd=FALSE)
}
plotrix/R/multhist.R 0000755 0001762 0000144 00000002221 14011145766 014155 0 ustar ligges users multhist <- function (x, beside=TRUE, freq=NULL, probability=!freq,
plot.it=TRUE, ...) {
## sort out histogram arguments
hist.args <- formals(hist.default)
args <- list(...)
hargs <- names(args)[names(args) %in% names(hist.args)]
hist.args[hargs] <- args[hargs]
hist.args$plot<-FALSE
allhist <- hist(unlist(x),hist.args$breaks,plot=FALSE)
## sort out barplot arguments
if(plot.it) {
barplot.args <- formals(barplot.default)
bargs <- names(args)[names(args) %in% names(barplot.args)]
barplot.args[bargs] <- args[bargs]
barplot.args$beside <- beside
if("ann" %in% names(barplot.args))
barplot.args$ann<-eval(barplot.args$ann,envir=barplot.args)
## prevent warnings
barplot.args$"..." <- barplot.args$inside <- NULL
if (!"names.arg" %in% bargs)
barplot.args$names.arg <- signif(allhist$mids, 2)
if (is.null(freq)) {
freq<-if(!missing(probability)) !as.logical(probability) else TRUE
}
comp <- if(freq) "counts" else comp<-"density"
combhist <-
t(sapply(x,function(z) hist(z,breaks=allhist$breaks,plot=FALSE)[[comp]]))
if(plot.it) do.call("barplot", c(list(combhist),barplot.args))
invisible(list(allhist,combhist))
}
}
plotrix/R/std.error.R 0000755 0001762 0000144 00000000572 14011145766 014235 0 ustar ligges users std.error<-function(x,na.rm) {
vn<-function(x) return(sum(!is.na(x)))
dimx<-dim(x)
if(is.null(dimx)) {
stderr<-sd(x,na.rm=TRUE)
vnx<-vn(x)
}
else {
if(is.data.frame(x)) {
vnx<-unlist(sapply(x,vn))
stderr<-unlist(sapply(x,sd,na.rm=TRUE))
}
else {
vnx<-unlist(apply(x,2,vn))
stderr<-unlist(apply(x,2,sd,na.rm=TRUE))
}
}
return(stderr/sqrt(vnx))
}
plotrix/R/labbePlot.R 0000644 0001762 0000144 00000003020 14011145766 014203 0 ustar ligges users # labbePlot reads a list of comparison trial results between two conditions,
# typically "placebo" and "intervention" for clinical trials,
# and plots each result as a circle centered at the percentage of successes
# for each condition, with radius proportional to the square root of the
# number of observations (multiplied by "circle.mag" for very small or large
# numbers of observations), with optional fill colors.
labbePlot<-function(x,main="L'Abbe plot",
xlab="Percent positive response with placebo",
ylab="Percent positive response with treatment",
labels=NULL,col=NA,circle.mag=0.5,add=FALSE,...) {
if(is.list(x)) {
if(!add)
plot(0,xlim=c(0,100),ylim=c(0,100),main=main,xlab=xlab,
ylab=ylab,type="n",...)
for(trial in 1:length(x)) {
if(is.matrix(x[[trial]])) {
sum_treat<-sum(x[[trial]][1,])
sum_interv<-sum(x[[trial]][2,])
xpos<-100*x[[trial]][1,1]/sum_treat
ypos<-100*x[[trial]][2,1]/sum_interv
rad<-circle.mag*sqrt(sum_treat+sum_interv)
}
else {
xpos<-x[[trial]][1]
ypos<-x[[trial]][2]
rad<-circle.mag*sqrt(x[[trial]][3])
}
circle.col<-ifelse(is.list(col),col[[trial]],col)
draw.circle(xpos,ypos,rad,col=circle.col)
if(!is.null(labels[[trial]])) {
textcol<-ifelse(colSums(col2rgb(circle.col)*c(1,1.4,0.6)) < 350,
"white", "black")
text(xpos,ypos,labels[[trial]],col=textcol)
}
}
segments(0,0,100,100)
}
else {
cat("labbePlot: x must be a list of 2x2 tables OR\n")
cat("3 element numeric vectors of percent, percent, N (see help page)\n")
}
}
plotrix/R/ablineclip.R 0000755 0001762 0000144 00000001077 14011145766 014416 0 ustar ligges users ablineclip<-function(a=NULL,b=NULL,h=NULL,v=NULL,reg=NULL,
coef=NULL,untf=FALSE,x1=NULL,x2=NULL,y1=NULL,y2=NULL,...) {
if(!is.null(c(x1,x2,y1,y2))) {
oldclip<-par("usr")
# if any clipping perimeters are not supplied, use the existing plot edges
if(is.null(x1)) x1<-oldclip[1]
if(is.null(x2)) x2<-oldclip[2]
if(is.null(y1)) y1<-oldclip[3]
if(is.null(y2)) y2<-oldclip[4]
clip(x1,x2,y1,y2)
abline(h=oldclip[4]+1)
clip(x1,x2,y1,y2)
}
abline(a=a,b=b,h=h,v=v,reg=reg,coef=coef,untf=untf,...)
if(!is.null(c(x1,x2,y1,y2))) do.call("clip",as.list(oldclip))
}
plotrix/R/color2D.matplot.R 0000755 0001762 0000144 00000011113 14011145766 015267 0 ustar ligges users hexagon<-function(x,y,unitcell=1,col=NA,border="black") {
polygon(c(x,x,x+unitcell/2,x+unitcell,x+unitcell,x+unitcell/2),
c(y+unitcell*0.125,y+unitcell*0.875,y+unitcell*1.125,y+unitcell*0.875,
y+unitcell*0.125,y-unitcell*0.125),col=col,border=border)
}
fill.corner<-function(x,nrow,ncol,na.value=NA) {
xlen<-length(x)
ncells<-ifelse(nrow*ncol < xlen,nrow*ncol,xlen)
newmat<-matrix(na.value,nrow=nrow,ncol=ncol)
xside<-1
while(xside*xside < ncells) xside<-xside+1
row=1
col=1
for(xindex in 1:ncells) {
newmat[row,col]<-x[xindex]
if(row == xside) {
col<-col+1
row<-1
}
else row<-row+1
}
return(newmat)
}
# returns a plot.coord list of the indices of the maximum
# or minimum value in a matrix
find_max_cell<-function(x,max=TRUE) {
if(max)
return(list(x=which.max(apply(x,2,max)),y=which.max(apply(x,1,max))))
else
return(list(x=which.min(apply(x,2,min)),y=which.min(apply(x,1,min))))
}
color2D.matplot<-function(x,cs1=c(0,1),cs2=c(0,1),cs3=c(0,1),
extremes=NA,cellcolors=NA,show.legend=FALSE,nslices=10,xlab="Column",
ylab="Row",do.hex=FALSE,axes=TRUE,show.values=FALSE,vcol=NA,vcex=1,
border="black",na.color=NA,xrange=NULL,color.spec="rgb",yrev=TRUE,
xat=NULL,yat=NULL,Hinton=FALSE,add=FALSE,...) {
if(diff(range(x,na.rm=TRUE)) == 0) {
if(Hinton) stop("No differences to display in Hinton plot.")
x<-x/max(x,na.rm=TRUE)
}
if(is.matrix(x) || is.data.frame(x)) {
xdim<-dim(x)
if(is.data.frame(x)) x<-unlist(x)
else x<-as.vector(x)
oldpar<-par("xaxs","yaxs","xpd","mar")
par(xaxs="i",yaxs="i")
if(do.hex) par(mar=c(5,4,4,4))
if(!add)
plot(c(0,xdim[2]),c(0,xdim[1]),xlab=xlab,ylab=ylab,type="n",axes=FALSE,...)
oldpar$usr<-par("usr")
if(!do.hex) {
box()
pos<-0
}
else pos<- -0.3
if(axes && !add) {
if(is.null(xat)) xat<-pretty(0:xdim[2])[-1]
axis(1,at=xat-0.5,labels=xat,pos=pos)
if(is.null(yat)) yat<-pretty(0:xdim[1])[-1]
axis(2,at=xdim[1]-yat+0.5,labels=yat)
}
if(all(is.na(cellcolors))) {
if(Hinton) {
if(is.na(extremes[1])) extremes<-c("black","white")
cellcolors<-extremes[(x > 0) + 1]
}
else cellcolors<-color.scale(x,cs1,cs2,cs3,extremes=extremes,
na.color=na.color,color.spec=color.spec)
}
# this sets the color for overprinted text to black or white
# depending upon what color will be the background for the text
if(is.na(vcol))
vcol<-ifelse(colSums(col2rgb(cellcolors)*c(1,1.4,0.6))<350,"white","black")
# if it's a Hinton diagram,cellsize = x, rescaling to 0.1,1 if necessary
if(Hinton) {
if(any(x < 0 | x > 1))
cellsize<-matrix(rescale(abs(x),c(0.03,1)),nrow=xdim[1])
}
else cellsize<-matrix(1,nrow=xdim[1],ncol=xdim[2])
# start from the top left - isomorphic with the matrix layout
if(do.hex) {
par(xpd=TRUE)
offset<-0
if(length(border) < xdim[1]*xdim[2])
border<-rep(border,length.out=xdim[1]*xdim[2])
for(row in 1:xdim[1]) {
for(column in 0:(xdim[2]-1)) {
hexagon(column+offset,xdim[1]-row,unitcell=cellsize[row,column+1],
col=cellcolors[row+xdim[1]*column],
border=border[row+xdim[1]*column])
if(show.values)
text(column+offset+0.5,xdim[1]-row+0.5,x[row+column*xdim[1]],
col=vcol[row+xdim[1]*column],cex=vcex)
}
offset<-ifelse(offset,0,0.5)
}
par(xpd=FALSE)
}
else {
if(Hinton) inset<-(1-cellsize)/2
else inset<-0
if(yrev) {
y0<-rep(seq(xdim[1]-1,0,by=-1),xdim[2])+inset
y1<-rep(seq(xdim[1],1,by=-1),xdim[2])-inset
}
else {
y0<-rep(0:(xdim[1]-1),xdim[2])+inset
y1<-rep(1:xdim[1],xdim[2])-inset
}
rect(sort(rep((1:xdim[2])-1,xdim[1]))+inset,y0,
sort(rep(1:xdim[2],xdim[1]))-inset,y1,
col=cellcolors,border=border)
if(show.values) {
if(yrev) texty<-rep(seq(xdim[1]-0.5,0,by=-1),xdim[2])
else texty<-rep(seq(0.5,xdim[1]-0.5,by=1),xdim[2])
text(sort(rep((1:xdim[2])-0.5,xdim[1])), texty,
formatC(round(x,show.values),format="f",digits=show.values),
col=vcol,cex=vcex)
}
}
naxs<-which(is.na(x))
xy<-par("usr")
plot.din<-par("din")
plot.pin<-par("pin")
bottom.gap<-(xy[3]-xy[4])*(plot.din[2]-plot.pin[2])/(2*plot.pin[2])
grx1<-xy[1]
gry1<-bottom.gap*0.95
grx2<-xy[1]+(xy[2]-xy[1])/4
gry2<-bottom.gap*0.8
if(length(cellcolors) > 1) {
colmat<-col2rgb(c(cellcolors[which.min(x)],cellcolors[which.max(x)]))
cs1<-colmat[1,]/255
cs2<-colmat[2,]/255
cs3<-colmat[3,]/255
color.spec<-"rgb"
}
rect.col<-color.scale(1:nslices,cs1,cs2,cs3,color.spec=color.spec)
if(show.legend)
color.legend(grx1,gry1,grx2,gry2,round(range(x,na.rm=TRUE),show.legend),
rect.col=rect.col)
par(oldpar)
}
else cat("x must be a data frame or matrix\n")
}
plotrix/R/display.overplot.R 0000644 0001762 0000144 00000004221 14011145766 015621 0 ustar ligges users find_overplots<-function(x,y,tol) {
xlen<-length(x)
flags<-1:xlen
xsep<-ysep<-xdup<-ydup<-xydup<-rep(NA,xlen)
nsep<-ndup<-0
for(i in 1:xlen) {
if(!is.na(flags[i])) {
dups<-abs(x - x[i]) <= tol[1] & abs(y - y[i]) <= tol[2]
ndups<-sum(dups,na.rm=TRUE)
if(ndups > 1) {
ndup<-ndup + 1
xydup[ndup]<-ndups
xdup[ndup]<-x[i]
ydup[ndup]<-y[i]
}
else {
nsep<-nsep + 1
xsep[nsep]<-x[i]
ysep[nsep]<-y[i]
}
}
flags[dups]<-NA
}
return(list(xsep=xsep,ysep=ysep,xdup=xdup,ydup=ydup,xydup=xydup))
}
display.overplots<-function(x,y,tol=NULL,how=c("count","cluster","size"),
xlim=NULL,ylim=NULL,col=rep(par("fg"),2),pch=c("1",1),spc=NULL,...) {
if(missing(x)) stop("display.overplots must have xy coordinates")
dimx<-dim(x)
if(missing(y)) {
if(is.list(x) && names(x)[1] == "x") {
y<-x[[2]]
x<-x[[1]]
}
else {
if(!is.null(dimx)) {
y<-x[,2]
x<-x[,1]
}
}
}
if(any(is.na(x) | is.na(y))) {
indices<-!is.na(x) & !is.na(y)
x<-x[indices]
y<-y[indices]
}
if(is.null(xlim)) xlim<-range(x)
if(is.null(ylim)) ylim<-range(y)
xlen<-length(x)
if(xlen != length(y)) stop("x and y must be the same length.")
plot(x,y,type="n",axes=FALSE,xlab="",ylab="")
xylim<-par("usr")
if(is.null(tol)) tol<-c(diff(xylim[1:2]/100),diff(xylim[3:4]/100))
else if(length(tol) == 1) tol <- rep(tol,2)
if(length(col) < xlen) col<-rep(col,xlen)
if(length(pch) < xlen) pch<-rep(pch,xlen)
if(is.null(spc)) spc<-c(diff(xylim[1:2])/100,diff(xylim[3:4]/100))
xy<-find_overplots(x,y,tol)
plot(xy$xsep,xy$ysep,xlim=xlim,ylim=ylim,col=col[1],pch=pch[1],...)
if(how[1] == "count") text(xy$xdup,xy$ydup,xy$xydup,col=col[2],...)
if(how[1] == "cluster") {
xshifts<-c(0,-spc[1],spc[1],0,0,-spc[1],spc[1],-spc[1],spc[1])
yshifts<-c(0,0,0,-spc[2],spc[2],-spc[2],spc[2],spc[2],-spc[2])
for(dup in 1:sum(!is.na(xy$xdup))) {
for(ndups in 1:min(c(xy$xydup[dup],9))) {
points(xy$xdup[dup]+xshifts[ndups],xy$ydup[dup]+yshifts[ndups],
pch=pch[2],col=col[2],...)
}
if(xy$xydup[dup] > 9) points(xy$xdup[dup],xy$ydup[dup],pch=4,cex=2)
}
}
if(how[1] == "size")
points(xy$xdup,xy$ydup,pch=pch[2],col=col[2],cex=sqrt(xy$xydup))
}
plotrix/R/color.legend.R 0000755 0001762 0000144 00000001655 14011145766 014671 0 ustar ligges users color.legend<-function (xl,yb,xr,yt,legend,rect.col,cex=1,align="lt",
gradient="x",...) {
oldcex<-par("cex")
par(xpd=TRUE,cex=cex)
gradient.rect(xl,yb,xr,yt,col=rect.col,nslices=length(rect.col),
gradient=gradient)
if(gradient == "x") {
xsqueeze<-(xr-xl)/(2*length(rect.col))
textx<-seq(xl+xsqueeze,xr-xsqueeze,length.out=length(legend))
if(match(align,"rb",0)) {
texty<-yb-0.2*strheight("O")
textadj<-c(0.5,1)
}
else {
# assume it's the default
texty<-yt+0.2*strheight("O")
textadj<-c(0.5,0)
}
}
else {
ysqueeze<-(yt-yb)/(2*length(rect.col))
texty<-seq(yb+ysqueeze,yt-ysqueeze,length.out=length(legend))
if(match(align,"rb",0)) {
textx<-xr+0.2*strwidth("O")
textadj<-c(0,0.5)
}
else {
# assume it's the default
textx<-xl-0.2*strwidth("O")
textadj<-c(1,0.5)
}
}
text(textx,texty,labels=legend,adj=textadj,...)
par(xpd=FALSE,cex=oldcex)
}
plotrix/R/spreadout.R 0000755 0001762 0000144 00000003031 14011145766 014312 0 ustar ligges users spreadout<-function(x,mindist) {
if(sum(!is.na(x)) < 2) return(x)
xorder<-order(x)
goodx<-x[xorder][!is.na(x[xorder])]
gxlen<-length(goodx)
start<-end<-gxlen%/%2
# nicely spread groups of short intervals apart from their mean
while(start > 0) {
while(end < gxlen && goodx[end+1] - goodx[end] < mindist) end<-end+1
while(start > 1 && goodx[start] - goodx[start-1] < mindist) start<-start-1
if(start < end) {
nsqueezed<-1+end-start
newx<-sum(goodx[start:end])/nsqueezed -
mindist*(nsqueezed%/%2 - (nsqueezed/2 == nsqueezed%/%2) * 0.5)
for(stretch in start:end) {
goodx[stretch]<-newx
newx<-newx+mindist
}
}
start<-end<-start-1
}
start<-end<-length(goodx)%/%2+1
while(start < gxlen) {
while(start > 1 && goodx[start] - goodx[start-1] < mindist) start<-start-1
while(end < gxlen && goodx[end+1] - goodx[end] < mindist) end<-end+1
if(start < end) {
nsqueezed<-1+end-start
newx<-sum(goodx[start:end])/nsqueezed -
mindist*(nsqueezed%/%2 - (nsqueezed/2 == nsqueezed%/%2) * 0.5)
for(stretch in start:end) {
goodx[stretch]<-newx
newx<-newx+mindist
}
}
start<-end<-end+1
}
# force any remaining short intervals apart
if(any(diff(goodx) < mindist)) {
start<-gxlen%/%2
while(start > 1) {
if(goodx[start] - goodx[start-1] < mindist)
goodx[start-1]<-goodx[start]-mindist
start<-start-1
}
end<-gxlen%/%2
while(end < gxlen) {
if(goodx[end+1] - goodx[end] < mindist)
goodx[end+1]<-goodx[end]+mindist
end<-end+1
}
}
x[xorder][!is.na(x[xorder])]<-goodx
return(x)
}
plotrix/R/draw.radial.line.R 0000644 0001762 0000144 00000002025 14011145766 015421 0 ustar ligges users draw.radial.line <- function(start, end, center=c(0, 0), angle=0, deg=NA, expand=FALSE,
col=NA, lwd=NA, ...)
{
if (is.na(col))
col <- par("col")
if (is.na(lwd))
lwd <- par("lwd")
if (is.na(deg))
deg <- angle*180/pi
angle <- deg*pi/180
cosang <- cos(angle)
sinang <- sin(angle)
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
if (!expand || end <= 0)
{
px <- c(start, end)
lines(center[1]+px*cosang, center[2]+px*sinang*ymult, col=col, lwd=lwd, ...)
}
else
{
devunits <- dev.size("px")
lwdend <- (lwd/2)*(xylim[2]-xylim[1])/devunits[1]
px <- c(start, start, end, end)
lwdstart <- lwdend * start/end
py <- c(lwdstart, -lwdstart, -lwdend, lwdend)
pxt <- center[1] + px*cosang - py*sinang*ymult
pyt <- center[2] + px*sinang + py*cosang*ymult
polygon(pxt, pyt, border=col, col=col)
}
}
plotrix/R/drawNestedBars.R 0000644 0001762 0000144 00000004214 14011145766 015215 0 ustar ligges users drawNestedBars<-function (x,start,end,shrink=0.1,errbars=FALSE,
intervals=TRUE,col=NA,labelcex=1,lineht=NULL,showall=TRUE,Nwidths = FALSE,
barlabels=NULL,showlabels=TRUE,arrow.cap=NA) {
barcol <- ifelse(is.list(col), col[[1]], col)
if(!is.null(x[[1]][[1]]) && (showall >= 1 || length(x[[1]]) == 1))
rect(start, 0, end, unlist(x[[1]][[1]]), col = barcol)
if(showlabels && !is.null(x[[1]][[1]]) && showall >= 1) {
if(!is.null(barlabels)) barlabel <- barlabels[[1]]
else barlabel <- names(x[[1]][[1]])
labely <- -lineht * length(x[[1]])
if (nchar(barlabels[[1]][1])) {
par(xpd = TRUE)
segments(c(start, end, start), c(0, 0, labely), c(start,
end, end), rep(labely, 3))
boxed.labels((start + end)/2, labely, barlabel, ypad = 1.4,
bg = ifelse(is.na(barcol), "white", barcol), cex = labelcex)
par(xpd = FALSE)
}
}
if (errbars && length(x[[1]]) == 1)
dispersion((start + end)/2, x[[1]][[1]], x[[2]][[1]],
x[[3]][[1]], intervals = intervals, arrow.cap = arrow.cap)
for (xcomp in 1:length(x)) x[[xcomp]][[1]] <- NULL
if (length(x[[1]])) {
nvalues <- length(unlist(x[[1]][[1]]))
if (is.list(col)) col[[1]] <- NULL
if (!is.null(barlabels) && length(barlabels) > 1) barlabels[[1]] <- NULL
barspace <- (end - start) * shrink
if(Nwidths) barwidth<-((end-start)-barspace)*x[[4]][[1]]/sum(x[[4]][[1]])
else barwidth <- rep(((end-start)-barspace)/nvalues,nvalues)
barspace <- barspace/(nvalues + 1)
for (nextval in 1:nvalues) {
newx <- list()
for (xcomp in 1:length(x))
newx[[xcomp]] <- lapply(x[[xcomp]], sliceArray, nextval)
newbarlabels <- barlabels
start <- start + barspace
newcol <- col
if(is.list(col)) newcol[[1]] <- col[[1]][nextval]
if(!is.null(barlabels)) newbarlabels[[1]]<-barlabels[[1]][nextval]
drawNestedBars(newx, start, start + barwidth[nextval],
shrink = shrink, errbars = errbars, col = newcol,
labelcex = labelcex, lineht = lineht, showall = showall + 1,
Nwidths = Nwidths, barlabels = newbarlabels,
showlabels = showlabels, arrow.cap = arrow.cap,intervals = intervals)
start <- start + barwidth[nextval]
}
}
}
plotrix/R/violin_plot.R 0000644 0001762 0000144 00000011271 14011145766 014644 0 ustar ligges users violin_plot<-function (X = rnorm(50),
at,
add = FALSE,
na.rm = TRUE,
bw,
violin_width,
violin_end_width = 0.005,
equal_width = TRUE,
show_box = TRUE,
box_width = 0.01,
box_col = "black",
show_outliers = TRUE,
outlier_pch = NA,
range = 1.5,
xlim,
ylim,
axes = TRUE,
ann = TRUE,
xlab = "",
ylab = "",
x_axis_labels,
main = "Violin Plot",
col = "red",
median_col = "white",
show_mean = FALSE,
mean_pch = 19,
mean_pch_col = "yellow",
...)
{
if (missing(at)) at <- sequence(NCOL(X))
if (missing(violin_width)) violin_width <- min(diff(c(0, at)))
if (missing(xlim)) xlim <- c(min(at) - violin_width/2, max(at) + violin_width/2)
if (missing(ylim)) ylim <- c(min(X, na.rm = TRUE), max(X, na.rm = TRUE))
if (missing(x_axis_labels)) {
if (is.null(names(X))) x_axis_labels <- at
else x_axis_labels <- names(X)
}
if (length(col) != length(at)) {
col <- rep(col, length.out = length(at))
}
if (!missing(bw)) bw <- rep(bw, length.out = length(at))
if (add == FALSE) {
plot(x = 1,
y = 1,
type = "n",
xlim = xlim,
ylim = ylim,
xlab = xlab,
ylab = ylab,
xaxt = "n",
ann = ann,
axes = axes)
if (axes)
axis(side = 1,
at = at,
labels = x_axis_labels)
if(ann) title(main = main)
}
if (NCOL(X) == 1){
if (missing(bw)) bw <- bw.nrd0(X)
max_dy <- max(density(X, bw = bw, na.rm = na.rm, n = 2048)$y)
}
if (NCOL(X) > 1){
if (missing(bw)) bw <- sapply(1:NCOL(X), function(i) bw.nrd0(X[,i]))
for (i in 1:NCOL(X)) {
max_dy <- max(sapply(1:NCOL(X), function(i) max(density(X[,i], bw = bw[i], na.rm = na.rm, n = 2048)$y)))
}
}
for (i in 1:NCOL(X)) {
if (NCOL(X) == 1) x <- X
else x <- X[, i]
if (na.rm == TRUE) x <- x[!is.na(x)]
d <- density(x, bw = bw[i], n = 2048)
b <- boxplot.stats(x, coef = range)
if (equal_width == FALSE) width_2 <- violin_width * max(d$y)/max_dy
else width_2 <- violin_width
violin_y <- rescale(d$x, range(x))
violin_x <- rescale(d$y, c(0, 0.48 * width_2))
if (!show_outliers){
ind1 <- findInterval(b$stats[1], violin_y)
ind2 <- findInterval(b$stats[5], violin_y)
violin_y <- violin_y[ind1:ind2]
violin_x <- violin_x[ind1:ind2]
}
polygon(x = c(at[i] + violin_end_width * width_2,
at[i] - violin_end_width * width_2,
at[i] - violin_x - violin_end_width * width_2,
at[i] - violin_end_width * width_2,
at[i] + violin_end_width * width_2,
rev(at[i] + violin_x + violin_end_width * width_2)),
y = c(min(violin_y),
min(violin_y),
violin_y,
max(violin_y),
max(violin_y),
rev(violin_y)),
col = col[i], ...)
if (show_box){
lines(x = c(at[i], at[i]),
y = b$stats[1:2],
lwd = 1,
lend = "butt")
lines(x = c(at[i], at[i]),
y = b$stats[4:5],
lwd = 1,
lend = "butt")
polygon(x = c(at[i] - box_width * violin_width,
at[i] + box_width * violin_width,
at[i] + box_width * violin_width,
at[i] - box_width * violin_width),
y = c(b$stats[2],
b$stats[2],
b$stats[4],
b$stats[4]),
col = box_col)
lines(x = c(at[i] - box_width * violin_width,
at[i] + box_width * violin_width),
y = c(b$stats[3],
b$stats[3]),
lwd = 4,
lend = "butt",
col = median_col)
}
if (show_mean)
points(x = at[i], y = mean(x), pch = mean_pch, col = mean_pch_col)
if (show_outliers)
points(x = rep(at[i], length(b$out)), y = b$out, pch = outlier_pch)
}
}
plotrix/R/p2p_arrows.R 0000644 0001762 0000144 00000000246 14011145766 014404 0 ustar ligges users p2p_arrows<-function(x1,y1,x2,y2,space=0.05,col=par("fg"),...) {
xspace<-(x2-x1)*space
yspace<-(y2-y1)*space
arrows(x1+xspace,y1+yspace,x2-xspace,y2-yspace,...)
}
plotrix/R/taylor.diagram.R 0000755 0001762 0000144 00000024036 14011145766 015231 0 ustar ligges users # Display a Taylor diagram
# Taylor K.E. (2001)
# Summarizing multiple aspects of model performance in a single diagram
# Journal of Geophysical Research, 106: 7183-7192.
# version 1.0
# progr. Olivier.Eterradossi, 12/2007
# 2007-01-12 - modifications and Anglicizing - Jim Lemon
# version 2.0
# progr. initiale OLE, 8/01/2007
# rev. OLE 3/09/2008 : remove samples with NA's from mean, sd and cor calculations
# 2008-09-04 - integration and more anglicizing - Jim Lemon
# 2008-12-09 - added correlation radii, sd arcs to the pos.cor=FALSE routine
# and stopped the pos.cor=FALSE routine from calculating arcs for zero radius
# Jim Lemon
# 2010-4-30 - added the gamma.col argument for pos.cor=TRUE plots - Jim Lemon
# 2010-6-24 - added mar argument to pos.cor=TRUE plots - Jim Lemon
# 2012-1-31 - added the cex.axis argument - Jim Lemon
# 2019-02-22 - added cex.axis to Olivier's text calls plus adj and srt
taylor.diagram<-function(ref,model,add=FALSE,col="red",pch=19,pos.cor = TRUE,
xlab = "Standard deviation", ylab = "", main = "Taylor Diagram",
show.gamma = TRUE, ngamma = 3, gamma.col = 8, sd.arcs = 0, ref.sd = FALSE,
sd.method = "sample", grad.corr.lines = c(0.2, 0.4, 0.6, 0.8, 0.9),
pcex = 1, cex.axis = 1, normalize = FALSE, mar = c(4, 3, 4, 3), ...) {
grad.corr.full <- c(0, 0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99, 1)
# convert any list elements or data frames to vectors
R <- cor(ref, model, use = "pairwise")
if (is.list(ref))
ref <- unlist(ref)
if (is.list(model))
ref <- unlist(model)
SD <- function(x, subn) {
meanx <- mean(x, na.rm = TRUE)
devx <- x - meanx
ssd <- sqrt(sum(devx * devx, na.rm = TRUE)/(length(x[!is.na(x)]) -
subn))
return(ssd)
}
subn <- sd.method != "sample"
sd.r <- SD(ref, subn)
sd.f <- SD(model, subn)
if (normalize) {
sd.f <- sd.f/sd.r
sd.r <- 1
}
maxsd <- 1.5 * max(sd.f, sd.r)
oldpar <- par("mar", "xpd", "xaxs", "yaxs")
if (!add) {
par(mar = mar)
# display the diagram
if (pos.cor) {
if (nchar(ylab) == 0)
ylab = "Standard deviation"
plot(0, xlim = c(0, maxsd*1.1), ylim = c(0, maxsd*1.1), xaxs = "i",
yaxs = "i", axes = FALSE, main = main, xlab = "",
ylab = ylab, type = "n", cex = cex.axis, ...)
mtext(xlab,side=1,line=2.3)
if (grad.corr.lines[1]) {
for (gcl in grad.corr.lines) lines(c(0, maxsd *
gcl), c(0, maxsd * sqrt(1 - gcl^2)), lty = 3)
}
# add the axes
segments(c(0, 0), c(0, 0), c(0, maxsd), c(maxsd,
0))
axis.ticks <- pretty(c(0, maxsd))
axis.ticks <- axis.ticks[axis.ticks <= maxsd]
axis(1, at = axis.ticks,cex.axis=cex.axis)
axis(2, at = axis.ticks,cex.axis=cex.axis)
if (sd.arcs[1]) {
if (length(sd.arcs) == 1)
sd.arcs <- axis.ticks
for (sdarc in sd.arcs) {
xcurve <- cos(seq(0, pi/2, by = 0.03)) * sdarc
ycurve <- sin(seq(0, pi/2, by = 0.03)) * sdarc
lines(xcurve, ycurve, col = "blue", lty = 3)
}
}
if (show.gamma[1]) {
# if the user has passed a set of gamma values, use that
if (length(show.gamma) > 1) gamma <- show.gamma
# otherwise make up a set
else gamma <- pretty(c(0, maxsd), n = ngamma)[-1]
if (gamma[length(gamma)] > maxsd)
gamma <- gamma[-length(gamma)]
labelpos <- seq(45, 70, length.out = length(gamma))
# do the gamma curves
for (gindex in 1:length(gamma)) {
xcurve <- cos(seq(0, pi, by = 0.03)) * gamma[gindex] + sd.r
# find where to clip the curves
endcurve <- which(xcurve < 0)
endcurve <- ifelse(length(endcurve), min(endcurve) -
1, 105)
ycurve <- sin(seq(0, pi, by = 0.03)) * gamma[gindex]
maxcurve <- xcurve * xcurve + ycurve * ycurve
startcurve <- which(maxcurve > maxsd * maxsd)
startcurve <- ifelse(length(startcurve), max(startcurve) +
1, 0)
lines(xcurve[startcurve:endcurve], ycurve[startcurve:endcurve],
col = gamma.col)
if (xcurve[labelpos[gindex]] > 0)
boxed.labels(xcurve[labelpos[gindex]], ycurve[labelpos[gindex]],
gamma[gindex], border = FALSE)
}
}
# the outer curve for correlation
xcurve <- cos(seq(0, pi/2, by = 0.01)) * maxsd
ycurve <- sin(seq(0, pi/2, by = 0.01)) * maxsd
lines(xcurve, ycurve)
bigtickangles <- acos(seq(0.1, 0.9, by = 0.1))
medtickangles <- acos(seq(0.05, 0.95, by = 0.1))
smltickangles <- acos(seq(0.91, 0.99, by = 0.01))
segments(cos(bigtickangles) * maxsd, sin(bigtickangles) *
maxsd, cos(bigtickangles) * 0.97 * maxsd, sin(bigtickangles) *
0.97 * maxsd)
par(xpd = TRUE)
# the inner curve for reference SD
if (ref.sd) {
xcurve <- cos(seq(0, pi/2, by = 0.01)) * sd.r
ycurve <- sin(seq(0, pi/2, by = 0.01)) * sd.r
lines(xcurve, ycurve)
}
points(sd.r, 0, cex = pcex)
text(cos(c(bigtickangles, acos(c(0.95, 0.99)))) *
1.05 * maxsd, sin(c(bigtickangles, acos(c(0.95,
0.99)))) * 1.05 * maxsd, c(seq(0.1, 0.9, by = 0.1),
0.95, 0.99),cex=cex.axis)
text(maxsd * 0.8, maxsd * 0.8, "Correlation", srt = 315,cex=cex.axis)
segments(cos(medtickangles) * maxsd, sin(medtickangles) *
maxsd, cos(medtickangles) * 0.98 * maxsd, sin(medtickangles) *
0.98 * maxsd)
segments(cos(smltickangles) * maxsd, sin(smltickangles) *
maxsd, cos(smltickangles) * 0.99 * maxsd, sin(smltickangles) *
0.99 * maxsd)
}
else {
x <- ref
y <- model
R <- cor(x, y, use = "pairwise.complete.obs")
E <- mean(x, na.rm = TRUE) - mean(y, na.rm = TRUE)
xprime <- x - mean(x, na.rm = TRUE)
yprime <- y - mean(y, na.rm = TRUE)
sumofsquares <- (xprime - yprime)^2
Eprime <- sqrt(sum(sumofsquares)/length(complete.cases(x)))
E2 <- E^2 + Eprime^2
if (add == FALSE) {
# pourtour du diagramme (display the diagram)
maxray <- 1.5 * max(sd.f, sd.r)
plot(c(-maxray, maxray), c(0, maxray), type = "n",
asp = 1, bty = "n", xaxt = "n", yaxt = "n",
xlim=c(-1.1*maxray,1.1*maxray),
xlab = xlab, ylab = ylab, main = main, cex = cex.axis)
discrete <- seq(180, 0, by = -1)
listepoints <- NULL
for (i in discrete) {
listepoints <- cbind(listepoints, maxray *
cos(i * pi/180), maxray * sin(i * pi/180))
}
listepoints <- matrix(listepoints, 2, length(listepoints)/2)
listepoints <- t(listepoints)
lines(listepoints[, 1], listepoints[, 2])
# axes x,y
lines(c(-maxray, maxray), c(0, 0))
lines(c(0, 0), c(0, maxray))
# lignes radiales jusque R = +/- 0.8
for (i in grad.corr.lines) {
lines(c(0, maxray * i), c(0, maxray * sqrt(1 -
i^2)), lty = 3)
lines(c(0, -maxray * i), c(0, maxray * sqrt(1 -
i^2)), lty = 3)
}
# texte radial
for (i in grad.corr.full) {
text(1.05 * maxray * i, 1.05 * maxray * sqrt(1 -
i^2), i, cex = cex.axis,adj=cos(i)/2)
text(-1.05 * maxray * i, 1.05 * maxray * sqrt(1 -
i^2), -i, cex = cex.axis,adj=1-cos(i)/2)
}
# sd concentriques autour de la reference
seq.sd <- seq.int(0, 2 * maxray, by = (maxray/10))[-1]
for (i in seq.sd) {
xcircle <- sd.r + (cos(discrete * pi/180) *
i)
ycircle <- sin(discrete * pi/180) * i
for (j in 1:length(xcircle)) {
if ((xcircle[j]^2 + ycircle[j]^2) < (maxray^2)) {
points(xcircle[j], ycircle[j], col = "darkgreen",
pch = ".")
if (j == 10)
text(xcircle[j], ycircle[j], signif(i,
2), cex = cex.axis, col = "darkgreen",srt=90)
}
}
}
# sd concentriques autour de l'origine
seq.sd <- seq.int(0, maxray, length.out = 5)
for (i in seq.sd) {
xcircle <- cos(discrete * pi/180) * i
ycircle <- sin(discrete * pi/180) * i
if (i)
lines(xcircle, ycircle, lty = 3, col = "blue")
text(min(xcircle), -0.06 * maxray, signif(i,
2), cex = cex.axis, col = "blue")
text(max(xcircle), -0.06 * maxray, signif(i,
2), cex = cex.axis, col = "blue")
}
text(0, -0.14 * maxray, "Standard Deviation",
cex = cex.axis, col = "blue")
text(0, -0.22 * maxray, "Centered RMS Difference",
cex = cex.axis, col = "darkgreen")
points(sd.r, 0, pch = 22, bg = "darkgreen", cex = pcex)
text(0, 1.2 * maxray, "Correlation Coefficient",
cex = cex.axis)
}
S <- (2 * (1 + R))/(sd.f + (1/sd.f))^2
# Taylor<-S
}
}
# display the points
points(sd.f * R, sd.f * sin(acos(R)), pch = pch, col = col,
cex = pcex)
invisible(oldpar)
}
plotrix/R/radial.pie.R 0000644 0001762 0000144 00000010256 14011145766 014320 0 ustar ligges users drawSectorAnnulus<-function(angle1,angle2,radius1,radius2,col,angleinc=0.03) {
if(angle1 > angle2) {
temp<-angle1
angle1<-angle2
angle2<-temp
}
if(radius1 > radius2) {
temp<-radius1
radius1<-radius2
radius2<-temp
}
angles<-seq(angle1,angle2,by=angleinc)
angles[length(angles)]<-angle2
xpos<-c(cos(angles)*radius1,cos(rev(angles))*radius2)
ypos<-c(sin(angles)*radius1,sin(rev(angles))*radius2)
polygon(xpos,ypos,col=col,border=col)
}
# plots sectors composed of one or more sectors of annuli on a circular grid.
# radial.extents are the radial extents of the sectors (a vector),
# optionally with sub-extents that define the annuli
# (a matrix with each sector a column)
# sector.edges are the positions of the radii that define the sectors,
# defaulting to n equal sectors filling the circle where
# n is the number of radial extents.
# sector.values are the values in each sector of an annulus that
# will be represented by colors and must be the same data type and
# dimension as radial.extents.
# If a list of sector colors is passed, it will take precedence
# and sector.colors will not be scaled from sector.values
radial.pie<-function(radial.extents,sector.edges=NULL,
sector.colors=NULL,cs1=c(0,1),cs2=c(0,1),cs3=c(0,1),alpha=1,
labels=NA,label.pos=NULL,radlab=FALSE,start=0,clockwise=FALSE,
label.prop=1.1,radial.lim=NULL,main="",xlab="",ylab="",mar=c(2,2,3,2),
show.grid=TRUE,show.grid.labels=4,show.radial.grid=TRUE,
grid.col="gray",grid.bg="transparent",grid.unit=NULL,
radial.labels=NULL,boxed.radial=TRUE,add=FALSE,...) {
if(is.null(radial.lim)) radial.lim<-range(radial.extents)
if(is.null(sector.edges)) {
if(clockwise)
sector.edges<-seq(2*pi+start,start,length.out=length(radial.extents)+1)
else
sector.edges<-seq(start,2*pi+start,length.out=length(radial.extents)+1)
}
if(is.null(label.pos))
label.pos<-sector.edges[-length(sector.edges)]+diff(sector.edges)/2
if(show.grid) {
if(length(radial.lim) < 3) grid.pos<-pretty(radial.lim)
else grid.pos<-radial.lim
if(grid.pos[1] < radial.lim[1]) grid.pos<-grid.pos[-1]
maxlength<-max(grid.pos-radial.lim[1])
}
else {
grid.pos<-NA
maxlength<-diff(radial.lim)
}
oldpar<-par("xpd","mar","pty")
if(!add) {
par(mar=mar,pty="s")
maxrad<-max(unlist(radial.extents))
plot(0,xlim=c(-maxrad,maxrad),ylim=c(-maxrad,maxrad),type="n",
axes=FALSE,xlab=xlab,ylab=ylab)
if(show.grid)
radial.grid(labels=labels,label.pos=label.pos,radlab=radlab,
radial.lim=radial.lim,start=start,clockwise=clockwise,
label.prop=label.prop,grid.pos=grid.pos,
grid.col=grid.col,grid.bg=grid.bg)
}
fadeColor<-function(col,nfades) {
rgbcol<-col2rgb(col)
redinc<-(255-rgbcol[1])/nfades
reds<-(rgbcol[1]+0:nfades*redinc)/255
greeninc<-(255-rgbcol[2])/nfades
greens<-(rgbcol[2]+0:nfades*greeninc)/255
blueinc<-(255-rgbcol[3])/nfades
blues<-(rgbcol[3]+0:nfades*blueinc)/255
return(rgb(reds[1:nfades],greens[1:nfades],blues[1:nfades]))
}
nsectors<-length(radial.extents)
if(is.list(radial.extents)) {
if(is.null(sector.colors)) sector.colors<-rainbow(nsectors)
for(sector in 1:nsectors) {
annuli<-radial.extents[[sector]]
annulus.colors<-fadeColor(sector.colors[[sector]],length(annuli))
for(annulus in 1:(length(annuli)-1)) {
drawSectorAnnulus(sector.edges[[sector]],sector.edges[[sector+1]],
annuli[annulus],annuli[annulus+1],annulus.colors[annulus])
}
}
}
else {
if(is.null(sector.colors)) sector.colors<-rainbow(nsectors)
for(sector in 1:nsectors) {
drawSectorAnnulus(sector.edges[sector],sector.edges[sector+1],
0,radial.extents[sector],sector.colors[sector])
}
}
if(show.grid.labels) {
if(show.grid.labels%%2) {
ypos<-grid.pos-radial.lim[1]
xpos<-rep(0,length(grid.pos))
if(show.grid.labels==1) ypos<--ypos
}
else {
xpos<-grid.pos-radial.lim[1]
ypos<-rep(0,length(grid.pos))
if(show.grid.labels==2) xpos<--xpos
}
if(is.null(radial.labels)) radial.labels<-grid.pos
if(!is.null(grid.unit))
radial.labels[length(grid.pos)]<-
paste(radial.labels[length(grid.pos)],grid.unit)
if(boxed.radial)
boxed.labels(xpos,ypos,radial.labels,border=FALSE,
cex=par("cex.lab"))
else text(xpos,ypos,radial.labels,cex=par("cex.lab"))
}
invisible(oldpar)
}
plotrix/R/kiteChart.R 0000755 0001762 0000144 00000005105 14011145766 014226 0 ustar ligges users kiteChart<-function(x,xlim=NA,ylim=NA,timex=TRUE,main="Kite chart",
xlab=ifelse(timex,"Time","Groups"),ylab=ifelse(timex,"Groups","Time"),
border=par("fg"),col=NULL,varpos=NA,varlabels=NA,varscale=FALSE,
timepos=NA,timelabels=NA,mar=c(5,4,4,4),axlab=c(1,2,3,4),
normalize=FALSE,shownorm=TRUE,...) {
# leave a bit more space on top if there is an axis
if(varscale || normalize) mar<-mar+c(0,0,!timex,timex)
dimx<-dim(x)
if(normalize) {
if(is.na(varpos[1])) varpos<-1:dimx[2]
kitewidths<-rep(1,dimx[2])
kitemax<-1
}
else {
if(is.na(varpos[1])) {
kitewidths<-apply(as.matrix(x),1,max,na.rm=TRUE)
varpos<-rep(0,length(kitewidths)-1)
varpos[1]<-1.1*kitewidths[1]/2
for(kite in 2:length(kitewidths))
varpos[kite]<-varpos[kite-1]+1.1*(kitewidths[kite-1]+kitewidths[kite])/2
kitemax<-1.1*sum(kitewidths)
}
else {
kitemax<-max(diff(varpos))
kitewidths<-apply(as.matrix(x),1,max,na.rm=TRUE)
}
}
oldmar<-par(mar=mar)
if(is.na(xlim[1])) {
if(timex) xlim<-c(1,dimx[2])
else {
if(normalize) xlim<-c(0.5,dimx[1]+0.5)
else xlim<-c(0,kitemax)
}
}
if(is.na(ylim[1])) {
if(timex) {
if(normalize) ylim<-c(0.5,dimx[1]+0.5)
else ylim<-c(0,kitemax)
}
else ylim<-c(1,dimx[2])
}
plot(0,xlim=xlim,ylim=ylim,main=main,xlab=xlab,ylab=ylab,type="n",
axes=FALSE,...)
if(is.na(varpos[1])) varpos<-1:dimx[1]
if(is.na(varlabels[1])) {
if(is.null(rownames(x))) varlabels<-varpos[1:dimx[1]]
else varlabels<-rownames(x)
}
axis(ifelse(timex,axlab[2],axlab[1]),at=varpos[1:dimx[1]],labels=varlabels)
if(is.na(timepos[1])) timepos<-1:dimx[2]
if(is.na(timelabels[1])) {
if(is.null(colnames(x))) timelabels<-timepos
else timelabels<-colnames(x)
}
axis(ifelse(timex,axlab[1],axlab[2]),at=timepos,labels=timelabels)
if(varscale && !normalize) {
plotlim<-par("usr")
mtext(round(kitewidths,1),side=3+timex,at=varpos)
axis(3+timex,at=c(varpos-kitewidths/2,varpos+kitewidths/2),
labels=rep("",2*length(varpos)))
}
box()
if(is.null(col)) col<-rainbow(dimx[1])
if(length(col) < dimx[1]) col<-rep(col,length.out=dimx[1])
for(krow in 1:dimx[1]) {
if(normalize) {
if(shownorm)
mtext(paste("*",signif(1/max(x[krow,]),digits=3)),
ifelse(timex,axlab[4],axlab[3]),at=varpos[krow],las=1)
x[krow,]<-x[krow,]/(max(x[krow,]))
}
xpos<-1:length(x[krow,])
if(timex)
polygon(c(xpos,rev(xpos)),
c(varpos[krow]+x[krow,]/2,
varpos[krow]-rev(x[krow,])/2),
col=col[krow],border=border)
else
polygon(c(varpos[krow]+x[krow,]/2,
varpos[krow]-rev(x[krow,])/2),
c(xpos,rev(xpos)),
col=col[krow],border=border)
}
invisible(oldmar)
}
plotrix/R/centipede.plot.R 0000755 0001762 0000144 00000007130 14011145766 015225 0 ustar ligges users # in general, get.segs expects a list with varying lengths of numeric values
# it returns a 4xn matrix of midpoints, upper and lower limits and Ns
# where N is the number of valid elements in the list or columns in a
# data frame.
get.segs<-function(x,mct="mean",lower.limit="std.error",
upper.limit=lower.limit) {
xlen<-length(x)
segs<-matrix(0,nrow=4,ncol=xlen)
for(i in 1:xlen) {
segs[1,i]<-do.call(mct,list(x[[i]],na.rm=TRUE))
segs[2,i]<-segs[1,i]-do.call(lower.limit,list(x[[i]],na.rm=TRUE))
segs[3,i]<-segs[1,i]+do.call(upper.limit,list(x[[i]],na.rm=TRUE))
segs[4,i]<-sum(!is.na(x[[i]]))
}
rownames(segs)<-c(mct,lower.limit,upper.limit,"valid.n")
colnames(segs)<-names(x)
return(segs)
}
centipede.plot<-function(segs,mct="mean",lower.limit="std.error",
upper.limit=lower.limit,left.labels=NULL,right.labels=NULL,sort.segs=TRUE,
main="",xlab=NA,pch=21,vgrid=NA,hgrid=NA,gridcol="lightgray",mar=NA,col=par("fg"),
bg="green",...) {
if(missing(segs)) {
cat("Usage: centipede.plot(segs,...)\n\twhere segs is a dstat object")
stop("or a matrix of midpoints and limits")
}
if(is.list(segs)) {
if(all(lapply(segs,is.numeric)))
segs<-get.segs(segs,mct=mct,lower.limit=lower.limit,
upper.limit=upper.limit)
else stop("If segs is a list, all the components must be numeric")
}
if(inherits(segs,"dstat")) {
midpoint<-"mean"
if(lower.limit == "var") {
if(rownames(segs)[2] == "var") ll<-segs[1,]-segs[2,]
if(rownames(segs)[2] == "sd") ll<-segs[1,]-segs[2,]*segs[2,]
}
if(upper.limit == "var") {
if(rownames(segs)[2] == "var") ul<-segs[1,]+segs[2,]
if(rownames(segs)[2] == "sd") ul<-segs[1,]+segs[2,]*segs[2,]
}
if(lower.limit == "sd") {
if(rownames(segs)[2] == "var") ll<-segs[1,]-sqrt(segs[2,])
if(rownames(segs)[2] == "sd") ll<-segs[1,]-segs[2,]
}
if(upper.limit == "sd") {
if(rownames(segs)[2] == "var") ul<-segs[1,]+sqrt(segs[2,])
if(rownames(segs)[2] == "sd") ul<-segs[1,]+segs[2,]
}
if(lower.limit == "std.error") {
if(rownames(segs)[2] == "var") ll<-segs[1,]-sqrt(segs[2,])/sqrt(segs[3,])
if(rownames(segs)[2] == "sd") ll<-segs[1,]-segs[2,]/sqrt(segs[3,])
}
if(upper.limit == "std.error") {
if(rownames(segs)[2] == "var") ul<-segs[1,]+sqrt(segs[2,])/sqrt(segs[3,])
if(rownames(segs)[2] == "sd") ul<-segs[1,]+segs[2,]/sqrt(segs[3,])
}
segs<-rbind(segs[1,],ll,ul,segs[3,])
}
segdim<-dim(segs)
if (sort.segs) {
seg.order<-order(segs[1,])
segs<-segs[,seg.order]
}
else seg.order<-1:segdim[2]
oldpar<-par("mar")
if(is.na(mar[1])) mar<-c(4,6,1+2*(nchar(main)>0),5)
par(mar=mar)
plot(x=c(min(segs[2,]),max(segs[3,])),y=c(1,segdim[2]),
main=main,xlab="",ylab="",type="n",axes=FALSE,...)
box()
if(!is.na(vgrid[1])) abline(v=vgrid,lty=1,col=gridcol)
if(is.null(hgrid)) abline(h=1:segdim[2],lty=2,col=gridcol)
else if(!is.na(hgrid[1])) abline(h=hgrid,lty=2,col=gridcol)
axis(1)
arrows(segs[2,],1:segdim[2],segs[3,],1:segdim[2],length=0.05,
angle=90,code=3,col=col)
points(segs[1,],1:segdim[2],pch=pch,col=col,bg=bg)
if(is.null(left.labels)) {
left.labels<-colnames(segs)
if(is.null(left.labels)) left.labels<-paste("V",seg.order,sep="")
}
else left.labels<-left.labels[seg.order]
plot.limits<-par("usr")
mtext(left.labels,2,line=0.2,at=1:segdim[2],adj=1,las=1)
if(is.null(right.labels))
right.labels<-paste(round(segs[1,],2),"(",segs[4,],")",sep="")
else right.labels<-right.labels[seg.order]
mtext(right.labels,4,line=0.2,at=1:segdim[2],adj=0,las=1)
if(is.na(xlab))
xlab<-paste("| -",rownames(segs)[2],"-",rownames(segs)[1],"-",
rownames(segs)[3],"- |")
if (nchar(xlab)) mtext(xlab,1,line = 2)
par(oldpar)
invisible(segs)
}
plotrix/R/radialtext.R 0000644 0001762 0000144 00000004022 14011145766 014443 0 ustar ligges users radialtext <- function(x, center=c(0,0), start=NA, middle=1, end=NA, angle=0, deg=NA,
expand=0, stretch=1, nice=TRUE, cex=NA, ...)
{
oldcex <- par("cex")
if (is.na(cex))
cex <- oldcex
par(cex=cex)
if (is.na(deg))
deg <- angle*180/pi
deg <- deg %% 360
chardeg <- deg
if (nice && (deg > 90 && deg < 270))
{
chardeg <- (deg + 180) %% 360
x <- paste(rev(unlist(strsplit(x, ""))),collapse="")
}
angle <- deg*pi/180
xvec <- strsplit(x, "")[[1]]
lenx <- length(xvec)
xwidths <- stretch * strwidth(xvec)
xwrange <- range(xwidths)
xwidths[xwidths < xwrange[2]/2] <- xwrange[2]/2 # Make really narrow characters wider
# Compute expand factor for each character and adjust character widths accordingly.
chexp <- rep(1, lenx)
if (!is.na(start) && expand != 0)
{
# Note: width of each char changes in succession, affecting sizes AND positions.
expfactor <- expand/start
deltar <- 0
for (xchar in 2:lenx)
{
deltar <- deltar + xwidths[xchar-1]
expansion <- 1+deltar*expfactor
if (expansion < 0.1) expansion <- 0.1
chexp[xchar] <- expansion
xwidths[xchar] <- xwidths[xchar]*expansion
}
}
# Find start distance
if (is.na(start))
{
if (is.na(end))
start <- middle - sum(xwidths)/2
else
start <- end - sum(xwidths)
}
cosang <- cos(angle)
sinang <- sin(angle)
charstart <- c(start, start + cumsum(xwidths)[-lenx])
charpos <- charstart + xwidths/2
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
for (xchar in 1:lenx)
{
par(cex=cex*chexp[xchar])
text(center[1] + charpos[xchar] * cosang,
center[2] + charpos[xchar] * ymult * sinang, xvec[xchar],
adj=c(0.5, 0.5), srt=chardeg, ...)
}
par(cex=oldcex)
}
plotrix/R/staxlab.R 0000755 0001762 0000144 00000002671 14011145766 013753 0 ustar ligges users # staxlab produces staggered axis tick labels
# note that barplot() tends to mess things up by plotting an X axis
# even when axes=FALSE
staxlab<-function(side=1,at,labels,nlines=2,top.line=0.5,
line.spacing=0.8,srt=NULL,ticklen=0.03,adj=1,...) {
if(missing(labels)) labels<-at
nlabels<-length(labels)
if(missing(at)) at<-1:nlabels
axislim<-par("usr")[3:4-2*side%%2]
if(any(at < axislim[1]) || any(at > axislim[2]))
warning("Some axis labels are off the plot")
if(is.null(srt)) {
linepos<-rep(top.line,nlines)
for(i in 2:nlines) linepos[i]<-linepos[i-1]+line.spacing
linepos<-rep(linepos,ceiling(nlabels/nlines))[1:nlabels]
axis(side=side,at=at,labels=rep("",nlabels))
mtext(text=labels,side=side,line=linepos,at=at,...)
}
else {
xylim<-par("usr")
if(side == 1) {
xpos<-at
if(par("ylog")) ypos<-10^(xylim[3]-ticklen*(xylim[4]-xylim[3]))
else ypos<-xylim[3]-ticklen*(xylim[4]-xylim[3])
}
if(side == 3) {
xpos<-at
if(par("ylog")) ypos<-10^(xylim[4]+ticklen*(xylim[4]-xylim[3]))
else ypos<-xylim[4]+ticklen*(xylim[4]-xylim[3])
}
if(side == 2) {
ypos<-at
if(par("xlog")) xpos<-10^(xylim[1]-ticklen*(xylim[2]-xylim[1]))
else xpos<-xylim[1]-ticklen*(xylim[2]-xylim[1])
}
if(side == 4) {
ypos<-at
if(par("xlog")) xpos<-10^(xylim[2]+ticklen*(xylim[2]-xylim[1]))
else xpos<-xylim[2]+ticklen*(xylim[2]-xylim[1])
}
par(xpd=TRUE)
text(xpos,ypos,labels,srt=srt,adj=adj,...)
par(xpd=FALSE)
}
}
plotrix/R/soil.texture.uk.R 0000755 0001762 0000144 00000004151 14011145766 015373 0 ustar ligges users # UK soil texture plot
soil.texture.uk <- function (soiltexture = NULL, main = "",
at = seq(0.1, 0.9, by = 0.1),
axis.labels = c("percent sand", "percent silt", "percent clay"),
tick.labels = list(l = seq(10, 90, by = 10), r = seq(10, 90, by = 10),
b = seq(10, 90, by = 10)), show.names = TRUE,
show.lines = TRUE, col.names = "gray", bg.names = par("bg"),
show.grid = FALSE, col.axis = "black", col.lines = "gray",
col.grid = "gray", lty.grid = 3, show.legend = FALSE, label.points = FALSE,
point.labels = NULL, col.symbols = "black", pch = par("pch"),
h1 = NA, h3 = NA, t1 = NA, t3 = NA, lwduk = 2, xpos = NA, ypos = NA,
snames = NA, cexuk = 1.1, ...) {
if(is.na(h1[1])) h1<-c(82, 85, 70, 50, 45, 20) / 100
if(is.na(h3[1])) h3<-c(18, 15, 30, 30, 35, 0) / 100
if(is.na(t1[1])) t1<-c(0, 70, 50, 45, 0, 20) / 100
if(is.na(t3[1])) t3<-c(18, 0, 30, 35, 35, 35) / 100
# Name positions (x and y, x starting form left point)
if(is.na(xpos[1])) xpos<-c(0.5,0.77,0.45,0.1,0.45,0.85)
if(is.na(ypos[1])) ypos<-c(0.65,0.265,0.265,0.07,0.1,0.1)
if(is.na(snames[1])) snames <- c("Clays","Medium silts","Medium loams",
"Sands","Light loams","Light silts")
par(xpd = TRUE)
triax.plot(x=NULL,main = main, at = at, axis.labels = axis.labels,
tick.labels = tick.labels, col.axis = col.axis, show.grid = show.grid,
col.grid = col.grid, lty.grid = lty.grid)
arrows(0.12, 0.41, 0.22, 0.57, length = 0.15)
arrows(0.78, 0.57, 0.88, 0.41, length = 0.15)
arrows(0.6, -0.1, 0.38, -0.1, length = 0.15)
if(show.lines) {
triax.segments <- function(h1, h3, t1, t3, col, lwd) {
segments(1 - h1 - h3/2, h3 * sin(pi/3), 1 - t1 -
t3/2, t3 * sin(pi/3), col = col, lwd = lwd)
}
triax.segments(h1 , h3, t1, t3, col.lines, lwduk)
}
if (show.names) {
boxed.labels(xpos, ypos* sin(pi/3), snames, border = FALSE,
xpad = 0.5, cex = cexuk)
}
par(xpd = FALSE)
if (is.null(soiltexture)) return(NULL)
soilpoints <- triax.points(soiltexture, show.legend = show.legend,
label.points = label.points, point.labels = point.labels,
col.symbols = col.symbols, pch = pch, ...)
invisible(soilpoints)
}
plotrix/R/plotH.R 0000644 0001762 0000144 00000003427 14011145766 013400 0 ustar ligges users plotH <- function (x,...) {
UseMethod("plotH")
}
plotH.formula <- function(x,data=NULL,xlab=names(mf)[2],ylab=names(mf)[1],...) {
mf <- model.frame(x,data=data) # get model frame
if (ncol(mf)>2) stop("Function currently only accepts one variable on RHS of formula")
plotH.default(mf[,2],mf[,1],xlab=xlab,ylab=ylab,...)
}
plotH.default <- function(x,y,xlab=paste(deparse(substitute(x))),
ylab=paste(deparse(substitute(y))),width=0.6,ylim=NULL,col="gray",...) {
plotHq <- function(x,y,xlab,ylab,width,ylim,col,...) {
if (is.null(width)) width <- min(diff(x))
xleft <- x-width/2
xright <- x+width/2
ytop <- y
ynegs <- y[is.finite(y)]<0
if (all(ynegs)) {
## All values negative: tops must be bottoms, bottom is top of ylim
ybottom <- ytop
if (is.null(ylim)) ylim <- c(min(y[is.finite(y)]),0)
ytop <- ylim[2]
} else if (any(ynegs)) {
# Some values negative: tops are fine, make bottoms =0
ybottom <- 0
if (is.null(ylim)) ylim <- range(y[is.finite(y)])
} else {
# All values positive: tops are fine, bottom is bottom of ylim
if (is.null(ylim)) ylim <- c(0,max(y[is.finite(y)]))
ybottom <- ylim[1]
}
plot(x,y,type="n",ylim=ylim,xlab=xlab,ylab=ylab,...)
rect(xleft,ybottom,xright,ytop,col=col,...)
} # end plotHq internal function
plotHc <- function(x,y,xlab,ylab,width,ylim,col,...) {
names(y) <- x
barplot(y,xlab=xlab,ylab=ylab,width=width,ylim=ylim,col=col,...)
} # end plotHc internal function
## Start of main function
if (!is.numeric(y)) stop("Y (or LHS) variable must be quantitative.")
if (is.numeric(x)) plotHq(x,y,xlab,ylab,width,ylim,col,...)
else plotHc(x,y,xlab,ylab,width,ylim,col,...)
}
plotrix/R/clustered.dotplots.R 0000644 0001762 0000144 00000005450 14011145766 016151 0 ustar ligges users clustered.dotplots<-function(xgroup, ygroup, freq, type = "circles",
main="",xlab="",ylab="",x_las=1,y_las=1,axes=TRUE,size=1,...) {
dfx = data.frame(xgroup = xgroup, ygroup = ygroup, freq = freq)
if(any(duplicated(dfx[,1:2]))){
stop("There can be only one 'frequency' for each pair of 'xgroup' and 'ygroup'")
}
x_unique <- unique(xgroup)
y_unique <- unique(ygroup)
plot(1, 1, asp = 1, xlim = c(0.5, 0.5+length(x_unique)),
ylim = c(0.5, 0.5+length(y_unique)), type = "n",
main=main,xlab = xlab, ylab = ylab, axes = FALSE)
if(axes == TRUE){
box()
axis(1, at = seq_along(x_unique), labels = x_unique, las = x_las)
axis(2, at = seq_along(y_unique), labels = y_unique, las = y_las)
}
spacing <- (1-0.10)/ceiling(sqrt(max(freq))) * size
#size can go from 0 to 1, 1 being the maximum spacing
for (i in 1:length(y_unique)){
#Subset dfx corresponding to first 'ygroup'
freq_subset <- subset(dfx, dfx$ygroup == y_unique[i])
for (j in 1:length(freq_subset$xgroup)){
#Determine the size of square matrix that can accomodate the frequency
matrix_sz <- ceiling(sqrt(freq_subset$freq[j]))
#Initialize y matrix
matrix_y <- matrix(rep(0, matrix_sz^2), nrow = matrix_sz)
#Determine 'relative' y-co-ordinates
matrix_y <- (NROW(matrix_y)+1)/2 - row(matrix_y)
#Initiate x matrix
matrix_x <- matrix(rep(0, matrix_sz^2), nrow = matrix_sz)
#Determine 'relative' x-co-ordinates
matrix_x <- col(matrix_x) - (NCOL(matrix_x)+1)/2
#Determine the co-ordinate of the center of the square matrix grid
x_center <- j
y_center <- i
#To keep track of symbols plotted
flag <- 1
# Plot circles around the center based on relative co-ordinates
for (rows in 1:matrix_sz){
for (columns in 1:matrix_sz){
if (flag > freq_subset$freq[j]){
#Break when the necessary number of points have been plotted
break
}
xx <- x_center + spacing * matrix_x[rows, columns]
yy <- y_center + spacing * matrix_y[rows, columns]
flag <- flag + 1
if(type == "circles"){
draw.circle(x = xx, y = yy, radius = spacing/2.05, ...) #Uses draw.circle of plotrix. Can be replaced with 'symbol'
}else if(type == "points"){
points(x = xx, y = yy, ...)
}
}
}
}
}
}
plotrix/R/twoord.stackplot.R 0000755 0001762 0000144 00000011242 14011145766 015630 0 ustar ligges users
twoord.stackplot <- function(lx, rx, ldata, rdata, lcol, rcol, ltype, rtype,
border, rylab, lylab, xlab, ..., incrylim=NULL,
halfwidth=0.4, leftfront=FALSE, mar = c(5, 4, 4, 4))
{
ltype <- sapply(ltype, function(x) match.arg(x, c("p","l","b","c","o","bar")))
rtype <- sapply(rtype, function(x) match.arg(x, c("p","l","b","c","o","bar")))
incrylim <- ifelse(is.null(incrylim), 0, as.numeric(incrylim))
#convert to matrix
if(is.vector(ldata))
ldata <- as.matrix(ldata)
if(is.vector(rdata))
rdata <- as.matrix(rdata)
#some default parameters
if(missing(border))
border <- "grey80"
if(missing(xlab))
xlab <- "x"
if(missing(rylab))
rylab <- "right y values"
if(missing(lylab))
lylab <- "left y values"
if(missing(lcol))
lcol <- palette()[1:NCOL(ldata)]
if(missing(rcol))
rcol <- palette()[1:NCOL(rdata)]
xlimits <- range(lx, rx)
#assume line plot for the left data, and barplot for the right data
oldmar <- par("mar")
par(mar = mar)
if(leftfront)
{
twoord.stackplot(rx, lx, rdata, ldata, rcol, lcol, rtype, ltype,
border, lylab, rylab, xlab, ..., incrylim=NULL,
halfwidth=0.4, leftfront=FALSE, mar = c(5, 4, 4, 4))
return(invisible())
}
#------------------------------------------------------------------------
#left y-axis plot
if(NCOL(ldata) > 1)
{
lcol <- rep(lcol, length=NCOL(ldata))
ltype <- rep(ltype, length=NCOL(ldata))
}
if(any(ltype == "bar"))
{
#------------------
lylimits <- range(ifelse(ldata <0, ldata, 0), rowSums(ldata))
lylimits[1] <- ifelse(lylimits[1] > 0, lylimits[1]*(1-incrylim), lylimits[1]*(1+incrylim))
lylimits[2] <- ifelse(lylimits[2] > 0, lylimits[2]*(1+incrylim), lylimits[2]*(1-incrylim))
plot(0, type = "n", axes = FALSE, xlim = xlimits, ylim = lylimits,
ylab="", xlab=xlab, ...)
xbottom <- par("usr")[1]
xylim <- par("usr")
ly <- ldata[,1]
rect(lx-halfwidth, ifelse(ly < 0, ly, xbottom), lx+halfwidth,
ifelse(ly > 0, ly, 0), col=lcol[1], border=border, ...)
if(NCOL(ldata) > 1)
for(i in 2:NCOL(ldata))
{
ly <- ldata[,i]
rect(lx-halfwidth, ifelse(ly < 0, ly, xbottom)+ldata[,i-1],
lx+halfwidth, ifelse(ly > 0, ly, 0)+ldata[,i-1], col=lcol[i],
border=border, ...)
}
}else
{
#------------------
lylimits <- range(ldata)
lylimits[1] <- ifelse(lylimits[1] > 0, lylimits[1]*(1-incrylim), lylimits[1]*(1+incrylim))
lylimits[2] <- ifelse(lylimits[2] > 0, lylimits[2]*(1+incrylim), lylimits[2]*(1-incrylim))
plot(lx, ldata[, 1], xlim=xlimits, ylim=lylimits, col=lcol[1],
type=ltype[1], axes=FALSE, ylab="", xlab=xlab, ...)
if(NCOL(ldata) > 1)
for(i in 2:NCOL(ldata))
lines(lx, ldata[, i], col=lcol[i], type=ltype[i], ...)
}
xylim <- par("usr")
mtext(lylab, 2, 2, col = lcol[1])
axis(1) #x axis
axat <- axis(2, col=lcol[1], labels=FALSE) #left y axis
abline(v=xylim[1], col=lcol[1])
mtext(axat, 2, 1, at = axat, col = lcol[1])
box()
#------------------------------------------------------------------------
#right y-axis plot
par(new=TRUE)
if(NCOL(rdata) > 1)
{
rcol <- rep(rcol, length=NCOL(rdata))
rtype <- rep(rtype, length=NCOL(rdata))
}
if(any(rtype == "bar"))
{
#------------------
rylimits <- range(ifelse(rdata <0, rdata, 0), rowSums(rdata))
rylimits[1] <- ifelse(rylimits[1] > 0, rylimits[1]*(1-incrylim), rylimits[1]*(1+incrylim))
rylimits[2] <- ifelse(rylimits[2] > 0, rylimits[2]*(1+incrylim), rylimits[2]*(1-incrylim))
ry <- rdata[,1]
plot(0, type = "n", axes = FALSE, xlim = xlimits, ylim = rylimits,
ylab="", xlab="", ...)
xbottom <- par("usr")[1]
xylim <- par("usr")
rect(rx-halfwidth, ifelse(ry < 0, ry, xbottom), rx+halfwidth,
ifelse(ry > 0, ry, 0), col=rcol[1], border=border, ...)
if(NCOL(rdata) > 1)
for(i in 2:NCOL(rdata))
{
ry <- rdata[,i]
rect(rx-halfwidth, ifelse(ry < 0, ry, xbottom)+rdata[,i-1],
rx+halfwidth, ifelse(ry > 0, ry, 0)+rdata[,i-1], col=rcol[i],
border=border, ...)
}
}else
{
#------------------
rylimits <- range(rdata)
rylimits[1] <- ifelse(rylimits[1] > 0, rylimits[1]*(1-incrylim), rylimits[1]*(1+incrylim))
rylimits[2] <- ifelse(rylimits[2] > 0, rylimits[2]*(1+incrylim), rylimits[2]*(1-incrylim))
plot(rx, rdata[, 1], xlim=xlimits, ylim=rylimits, col=rcol[1],
type=rtype[1], axes=FALSE, ylab="", xlab="", ...)
if(NCOL(rdata) > 1)
for(i in 2:NCOL(rdata))
lines(rx, rdata[, i], col=rcol[i], type=rtype[i], ...)
}
axat <- axis(4, col=rcol[1], labels=FALSE) #right y axis
abline(v=xylim[1], col=rcol[1])
mtext(axat, 4, 1, at = axat, col = rcol[1])
mtext(rylab, 4, 2, col = rcol[1])
par(mar = oldmar)
}
plotrix/R/radial.plot.R 0000755 0001762 0000144 00000020532 14114543262 014517 0 ustar ligges users # plots data as radial lines or a polygon on a 24 hour "clockface" going
# clockwise. clock.pos should be in decimal hours between 0 and 24.
# use hm2dec=TRUE to convert hour/minute values to hour/decimal values.
# example: clock24.plot(rnorm(16)+3,seq(5.5,20.5,length.out=16))
clock24.plot<-function(lengths,clock.pos,labels=0:23,minutes=FALSE,
hm2dec=FALSE,label.pos=NULL,rp.type="r",loglen=FALSE,explab=FALSE,...) {
npos<-length(lengths)
# if no positions are given, spread the lines out over the circle
if(missing(clock.pos)) clock.pos<-seq(0,24-24/(npos+1),length=npos)
else {
if(hm2dec) {
splittime<-strsplit(clock.pos,":")
hm2dh<-function(x) return(as.numeric(x[1])+as.numeric(x[2])/60)
clock.pos<-sapply(splittime,hm2dh)
}
}
# start at "midnight" and go clockwise
radial.pos<-pi*(clock.pos*15)/180
if(minutes) labels<-paste(labels,"00",sep=":")
if(is.null(label.pos)) label.pos<-seq(0,pi*1.917,length.out=24)
invisible(radial.plot(lengths,radial.pos,labels=labels,label.pos=label.pos,
rp.type=rp.type,start=pi/2,clockwise=TRUE,loglen=loglen,explab=explab,...))
}
# plots data as radial lines or a polygon starting at the right and going
# counterclockwise.
# angles should be given in 0-360 values, use radial.plot for radians
# example: polar.plot(rnorm(20)+3,seq(90,280,by=10))
polar.plot<-function(lengths,polar.pos=NULL,labels,label.pos=NULL,
start=0,clockwise=FALSE,rp.type="r",loglen=FALSE,explab=FALSE,...) {
npoints<-length(lengths)
if(is.null(polar.pos)) {
halfinc<-pi/npoints # evenly spaced, offset from zero
radial.pos<-seq(halfinc,2*pi-halfinc,length.out=npoints)
}
else radial.pos<-pi*polar.pos/180
if(start) start<-pi*start/180
if(missing(labels)) {
labels<-label.pos<-seq(0,340,by=20)
label.pos<-pi*label.pos/180
}
invisible(radial.plot(lengths,radial.pos,labels,label.pos,start=start,
clockwise=clockwise,rp.type=rp.type,loglen=loglen,explab=explab,...))
}
# plots radial lines of length 'lengths', symbols at 'lengths' from the
# center or a polygon with corresponding vertices at 'radial.pos' in radians.
# starts at the 'east' position and goes counterclockwise unless
# the "start" and "clockwise" arguments are changed
# label.prop is the proportion of max(lengths) that gives the
# radial position of the labels
radial.plot<-function(lengths,radial.pos=NULL,labels=NA,label.pos=NULL,
radlab=FALSE,start=0,clockwise=FALSE,rp.type="r",label.prop=1.1,main="",
xlab="",ylab="",line.col=par("fg"),lty=par("lty"),lwd=par("lwd"),
mar=c(2,2,3,2),show.grid=TRUE,show.grid.labels=4,show.radial.grid=TRUE,
rad.col="gray",grid.col="gray",grid.bg="transparent",grid.left=FALSE,
grid.unit=NULL,point.symbols=1,point.col=par("fg"),show.centroid=FALSE,
radial.lim=NULL,radial.labels=NULL,boxed.radial=TRUE,poly.col=NA,
add=FALSE,loglen=FALSE,explab=FALSE,...) {
# first convert lengths to log values if desired
if(loglen) lengths<-do.call(log10,list(lengths))
if(is.null(radial.lim)) radial.lim<-c(floor(min(lengths,na.rm=TRUE)),
ceiling(max(lengths,na.rm=TRUE)))
length.dim<-dim(lengths)
if(is.null(length.dim)) {
npoints<-length(lengths)
nsets<-1
lengths<-matrix(lengths,nrow=1)
}
else {
npoints<-length.dim[2]
nsets<-length.dim[1]
lengths<-as.matrix(lengths)
}
lengths<-lengths-radial.lim[1]
lengths[lengths<0]<-NA
if(is.null(radial.pos)) {
halfinc<-pi/npoints # evenly spaced, offset from zero
radial.pos<-seq(halfinc,2*pi-halfinc,length.out=npoints)
}
if(is.null(label.pos)) label.pos=radial.pos
radial.pos.dim<-dim(radial.pos)
if(is.null(radial.pos.dim))
radial.pos<-matrix(rep(radial.pos,nsets),nrow=nsets,byrow=TRUE)
else radial.pos<-as.matrix(radial.pos)
if(rp.type == "l" && clockwise == TRUE) start<-pi/2
if(clockwise) radial.pos<--radial.pos
if(start) radial.pos<-radial.pos+start
if(show.grid) {
if(loglen == 0) {
if(length(radial.lim) < 3) grid.pos<-pretty(radial.lim)
else grid.pos<-radial.lim
} else {
# log scaling is ON
rangerl<-ceiling(radial.lim)
grid.pos<-rangerl[1]:rangerl[2]
oddnum<-length(grid.pos) %% 2
if(oddnum) dropit<-2
while(length(grid.pos) > 6) {
if(oddnum) {
grid.pos<-grid.pos[-dropit]
dropit<-dropit+1
} else {
grid.pos<-grid.pos[seq(1,length(grid.pos),by=2)]
}
}
if(is.null(radial.labels)) {
if(explab) radial.labels<-paste0(10,"^",grid.pos)
else radial.labels<-10^grid.pos
}
if(grid.pos[1] < radial.lim[1]) grid.pos[1]<-radial.lim[1]
angles<-seq(0,1.96*pi,by=0.04*pi)
}
maxlength<-max(grid.pos-radial.lim[1])
} else {
grid.pos<-NA
maxlength<-diff(radial.lim)
}
oldpar<-par("xpd","mar","pty")
if(!add) {
par(mar=mar,pty="s")
plot(c(-maxlength,maxlength),c(-maxlength,maxlength),type="n",axes=FALSE,
main=main,xlab=xlab,ylab=ylab)
if(show.grid) {
radial.grid(labels=labels,label.pos=label.pos,radlab=radlab,
radial.lim=radial.lim,start=start,clockwise=clockwise,
label.prop=label.prop,grid.pos=grid.pos,rad.col=rad.col,
grid.col=grid.col,grid.bg=grid.bg,
show.radial.grid=show.radial.grid)
}
}
par(xpd=TRUE)
# stretch everything out to the correct length
if(length(line.col) < nsets) line.col<-1:nsets
if(length(rp.type) < nsets) rp.type<-rep(rp.type,length.out=nsets)
if(length(point.symbols) < nsets)
point.symbols<-rep(point.symbols,length.out=nsets)
if(length(point.col) < nsets) point.col<-rep(point.col,length.out=nsets)
if(length(poly.col) < nsets) poly.col<-rep(poly.col,length.out=nsets)
if(length(lty) < nsets) lty<-rep(lty,length.out=nsets)
if(length(lwd) < nsets) lwd<-rep(lwd,length.out=nsets)
for(i in 1:nsets) {
if(nsets > 1) {
linecol<-line.col[i]
polycol<-poly.col[i]
pointcol<-point.col[i]
pointsymbols<-point.symbols[i]
ltype<-lty[i]
lwidth<-lwd[i]
}
else {
linecol<-line.col
polycol<-poly.col
pointcol<-point.col
pointsymbols<-point.symbols
ltype<-lty
lwidth<-lwd
}
# split up rp.type if there is a combination of displays
rptype<-unlist(strsplit(rp.type[i],""))
if(match("s",rptype,0)) {
if(is.null(pointsymbols)) pointsymbols<-i
if(is.null(pointcol)) pointcol<-i
}
# get the vector of x positions
xpos<-cos(radial.pos[i,])*lengths[i,]
# get the vector of y positions
ypos<-sin(radial.pos[i,])*lengths[i,]
# plot radial lines if rp.type == "r"
if(match("r",rptype,0))
segments(0,0,xpos,ypos,col=linecol,lty=ltype,lwd=lwidth,...)
if(match("p",rptype,0))
polygon(xpos,ypos,border=linecol,col=polycol,lty=ltype,
lwd=lwidth,...)
if(match("s",rptype,0))
points(xpos,ypos,pch=point.symbols,col=pointcol,...)
if(match("t",rptype,0)) {
if(boxed.radial)
boxed.labels(xpos,ypos,point.symbols,col=pointcol)
else text(xpos,ypos,point.symbols,col=pointcol)
}
if(match("l",rptype,0))
lines(xpos,ypos,lty=ltype,lwd=lwidth,col=linecol,...)
if(show.centroid) {
if(match("p",rptype,0)) {
nvertices<-length(xpos)
# first get the "last to first" area component
polygonarea<-xpos[nvertices]*ypos[1] - xpos[1]*ypos[nvertices]
for(vertex in 1:(nvertices-1))
polygonarea<-
polygonarea+xpos[vertex]*ypos[vertex+1]-xpos[vertex+1]*ypos[vertex]
polygonarea<-polygonarea/2
centroidx<-
(xpos[nvertices]+xpos[1])*(xpos[nvertices]*ypos[1]-xpos[1]*ypos[nvertices])
centroidy<-
(ypos[nvertices]+ypos[1])*(xpos[nvertices]*ypos[1]-xpos[1]*ypos[nvertices])
for(vertex in 1:(nvertices-1)) {
centroidx<-centroidx + (xpos[vertex]+xpos[vertex+1])*
(xpos[vertex]*ypos[vertex+1]-xpos[vertex+1]*ypos[vertex])
centroidy<-centroidy + (ypos[vertex]+ypos[vertex+1])*
(xpos[vertex]*ypos[vertex+1]-xpos[vertex+1]*ypos[vertex])
}
points(centroidx/(6*polygonarea),centroidy/(6*polygonarea),
col=point.col[i],pch=point.symbols[i],cex=2,...)
}
else
points(mean(xpos),mean(ypos),col=pointcol,pch=pointsymbols,
cex=2,...)
}
}
if(show.grid.labels && !add) {
if(show.grid.labels%%2) {
ypos<-grid.pos-radial.lim[1]
xpos<-rep(0,length(grid.pos))
if(show.grid.labels==1) ypos<--ypos
}
else {
xpos<-grid.pos-radial.lim[1]
ypos<-rep(0,length(grid.pos))
if(show.grid.labels==2) xpos<--xpos
}
if(is.null(radial.labels)) radial.labels<-grid.pos
if(!is.null(grid.unit))
radial.labels[length(grid.pos)]<-
paste0(radial.labels[length(grid.pos)],grid.unit)
if(boxed.radial)
boxed.labels(xpos,ypos,radial.labels,border=FALSE,
cex=par("cex.lab"))
else text(xpos,ypos,radial.labels,cex=par("cex.lab"))
}
invisible(oldpar)
}
plotrix/R/add.ps.R 0000744 0001762 0000144 00000003316 14011145766 013461 0 ustar ligges users add.ps<-function(data,col.id,col.offset,col.x,col.value,fun.aggregate="mean",
ref.offset=1,prefixes,alternative=c("two.sided","less","greater"),mu=0,
paired=FALSE,var.equal=FALSE,lty=0,...) {
round.ps<-function(x) {
as.character(ifelse(x < 0.001,"<.001",
ifelse(x < 0.01,paste0("=",substr(round(x,3),2,5)),
ifelse(x < 0.05 && round(x,2) == 0.05,"<.05",
ifelse(round(x,2) == 1,">.99",paste0("=",substr(round(x,2),2,4)))))))
}
if(!is.data.frame(data)) stop("data must be a data.frame")
columns <- c(col.id, col.offset, col.x, col.value)
if (any(!(columns %in% colnames(data)))) stop("column not matching the data")
formula.agg <- as.formula(paste(col.value, "~", col.id, "+", col.offset, "+", col.x))
d.new <- aggregate(formula.agg, data = data, FUN = fun.aggregate)
#so far same as in rm.plot2
l.offset <- levels(factor(d.new[,col.offset]))
l.offset.test <- l.offset[-ref.offset]
if (missing(prefixes)) prefixes <- paste("p(", l.offset.test, ")", sep = "")
l.x <- levels(factor(d.new[,col.x]))
for (c.offset in seq_along(l.offset.test)) {
tmp.ps <- vector("numeric", length(l.x))
for (c.x in seq_along(l.x)) {
tmpx <- d.new[d.new[,col.offset] == l.offset[ref.offset] & d.new[,col.x] == l.x[c.x], ]
tmpx <- tmpx[order(tmpx[,col.id]),]
tmpy <- d.new[d.new[,col.offset] == l.offset.test[c.offset] & d.new[,col.x] == l.x[c.x], ]
tmpy <- tmpy[order(tmpy[,col.id]),]
tmp.ps[c.x] <- t.test(tmpx[,col.value], tmpy[,col.value], alternative = alternative, mu = mu, paired = paired, var.equal = var.equal)$p.value
}
tmp.labels <- paste(prefixes[c.offset], round.ps(tmp.ps), sep = "")
axis(1,seq_along(l.x), labels = tmp.labels, line = c.offset, lty = lty, ...)
}
}
plotrix/R/clean.args.R 0000755 0001762 0000144 00000001124 14011145766 014322 0 ustar ligges users clean.args<-function(argstr,fn,exclude.repeats=FALSE,exclude.other=NULL,
dots.ok=TRUE) {
fnargs<-names(formals(fn))
if(length(argstr) > 0 && !("..." %in% fnargs && dots.ok)) {
badargs<-names(argstr)[!sapply(names(argstr),"%in%",c(fnargs,""))]
for(i in badargs) argstr[[i]]<-NULL
}
if(exclude.repeats) {
ntab<-table(names(argstr))
badargs<-names(ntab)[ntab > 1 & names(ntab) != ""]
for (i in badargs) argstr[[i]]<-NULL
}
for(i in exclude.other) argstr[[i]]<-NULL
argstr
}
remove.args<-function(argstr,fn) {
fnargs <- names(formals(fn))
argstr[!(names(argstr) %in% fnargs)]
}
plotrix/R/fan.plot.R 0000755 0001762 0000144 00000007773 14011145766 014046 0 ustar ligges users fan.plot<-function (x,edges=200,radius=1,col=NULL,align.at=NULL,
max.span=NULL,labels=NULL,labelpos=NULL,label.radius=1.2,align="left",
shrink=0.02,main="",ticks=NULL,include.sumx=FALSE,...) {
if(!is.numeric(x) || any(is.na(x) | x <= 0))
stop("fan.plot: x values must be positive numbers.")
nticks<-ifelse(ticks==1,sum(x),ticks)
if(include.sumx) x<-c(x,sum(x))
xorder<-order(x,decreasing=TRUE)
oldmar<-par("mar")
# convert values into angular extents summing to 2*pi
if (align == "center") x<-pi*x/sum(x)
else x<-2*pi*x/sum(x)
# stretch or shrink the values to fit into max.span if specified
if(!is.null(max.span)) x<-x*max.span/max(x)
if(is.null(align.at)) {
if(align == "center") align.at<-pi/2
if(align == "right") align.at<-(pi - x[xorder[1]])/2
if(align == "left") align.at<-(pi + x[xorder[1]])/2
}
nx<-length(x)
tempradius<-radius
if(is.null(col)) col<-rainbow(nx)
else if(length(col) < nx) col<-rep(col,length = nx)
# center should be 0,0
if(align == "left") lowpoint<-min(sin(align.at-x))
else lowpoint<-min(sin(align.at+x))
if(lowpoint > 0) lowpoint<-0
par(mar=c(5,2,1,2),xpd=TRUE)
xspan<-max(label.radius+0.012*max(nchar(labels)))
plot(0,xlim=c(-xspan,xspan),ylim=c(lowpoint,xspan),
xlab="",ylab="",type="n",axes=FALSE)
xy<-par("usr")
pinxy<-par("pin")
ymult<-(xy[4]-xy[3])/(xy[2]-xy[1])*(pinxy[1]/pinxy[2])
if(nchar(main))
text(0,(max(label.radius)+0.2)*ymult,main,cex=1.5,adj=c(0.5,1))
for(i in 1:nx) {
n<-edges*x[xorder[i]]/pi
if(align == "center")
t2p<-seq(align.at-x[xorder[i]],align.at+x[xorder[i]],length=n)
if (align == "right")
t2p<-seq(align.at,align.at+x[xorder[i]],length=n)
if(align=="left")
t2p<-seq(align.at-x[xorder[i]],align.at,length=n)
xc<-c(cos(t2p)*tempradius,0)
yc<-c(sin(t2p)*tempradius*ymult,0)
polygon(xc,yc,col=col[xorder[i]],...)
tempradius<-tempradius-shrink
}
if(!is.null(ticks)) {
if(align == "left")
tickles<-seq(align.at,align.at-x[xorder[1]],by=-sum(x)/ticks)
if(align == "right")
tickles<-seq(align.at,align.at+x[xorder[1]],by=sum(x)/ticks)
if(align == "center")
tickles<-c(seq(align.at,align.at+x[xorder[1]],by=sum(x)/(2*ticks)),
seq(align.at,align.at-x[xorder[1]],by=-sum(x)/(2*ticks)))
stickout<-rep(c(0.04,rep(0.02,4),0.03,rep(0.02,4)),
length.out=length(tickles))
xpos1<-cos(tickles) * (radius + stickout)
ypos1<-sin(tickles) * ymult * (radius + stickout)
xpos2<-cos(tickles) * radius
ypos2<-sin(tickles) * ymult * radius
segments(xpos1, ypos1, xpos2, ypos2)
}
if(!is.null(labels)) {
par(xpd=TRUE)
if(align == "center") {
labelside<-rep(c(1, -1),length.out=nx-1)
lpos<-c(align.at+labelside*(x[xorder[1:(nx-1)]]+
(x[xorder[2:nx]]-x[xorder[1:(nx-1)]])/2),align.at)
}
if(align == "right") {
lpos<-align.at+(x[xorder]-c((x[xorder[1:(nx-1)]]-
x[xorder[2:nx]])/2,x[xorder[nx]]/2))
labelside<-rep(1,nx)
}
if(align == "left") {
lpos<-align.at-(x[xorder]-c((x[xorder[1:(nx-1)]]-
x[xorder[2:nx]])/2,x[xorder[nx]]/2))
labelside<-rep(-1,nx)
}
if(is.null(labelpos)) {
labelpos<-lpos
ldiff<-abs(diff(labelpos))
squeezers<-which(ldiff<0.15)
if(length(squeezers)) {
for(squeeze in squeezers) {
labelpos[1:squeeze]<-labelpos[1:squeeze]+
(0.15-ldiff[squeeze]) * labelside[1:squeeze]
labelpos[(squeeze+1):nx]<-labelpos[(squeeze+1):nx]-
(0.15-ldiff[squeeze]) * labelside[(squeeze+1):nx]
}
}
}
innerend<-seq(0.98,by=-shrink,length=nx)
endpos<-lpos
if(length(label.radius) < nx)
label.radius<-rep(label.radius,length.out=nx)
xpos1<-cos(labelpos)*label.radius[xorder]
ypos1<-sin(labelpos)*ymult*label.radius[xorder]
for(i in 1:nx)
boxed.labels(xpos1[i],ypos1[i],labels[xorder[i]],
border=FALSE,xpad=0,ypad=0.1,adj=c(0.5-cos(labelpos[i])/2.5,0.5))
xpos1<-cos(labelpos)*(label.radius[xorder]+radius)/2
ypos1<-sin(labelpos)*ymult*(label.radius[xorder]+radius)/2
xpos2<-cos(endpos)*radius*innerend
ypos2<-sin(endpos)*ymult*radius*innerend
segments(xpos1,ypos1,xpos2,ypos2)
}
par(mar=oldmar,xpd=FALSE)
invisible(labelpos)
}
plotrix/R/intersectDiagram.R 0000644 0001762 0000144 00000013143 14011145766 015573 0 ustar ligges users intersectDiagram<-function(x,pct=FALSE,show.nulls=FALSE,xnames=NULL,
sep="+",mar=c(0,0,3,0),main="Intersection Diagram",cex=1,col=NULL,
minspacing=NA,all.intersections=FALSE,include=NULL,
null.label="Non-set") {
matchParts<-function(x,table,ignore.case=TRUE) {
for(pattern in 1:length(x)) {
match_index<-grep(x[pattern],table,ignore.case=ignore.case)
if(length(match_index)) return(match_index)
}
return(0)
}
if(!inherits(x,"intersectList")) {
if(is.matrix(x) || is.data.frame(x)) {
if(is.data.frame(x))
x<-as.matrix(x)
x<-makeIntersectList(x,xnames=xnames,sep=sep)
}
if(!inherits(x,"intersectList"))
stop("x must be a matrix, data frame or intersectList")
}
oldmar<-par("mar")
par(mar=mar)
# attribute labels
attributes<-x[[length(x)]]
# get all the names for the individual attributes
if(is.null(include)) include<-attributes
# total number of attributes
nattributes<-length(attributes)
# peel off the number of objects and the attributes for display
x[[length(x)]]<-NULL
nobjects<-x[[length(x)]]
x[[length(x)]]<-NULL
# number of intersection levels with at least one object
nlevels<-length(x)
# if no colors specified, use rainbow
if(is.null(col)) col<-c(rainbow(nattributes),NA)
else
if(length(col) < nattributes) col<-rep(col,length.out=nattributes)
# total number of objects for each intersection level
objectsums<-sapply(x,sum)
# index of level with the most objects
maxlevel<-which.max(objectsums)
nNonZero<-function(x) return(sum(x > 0))
# number of intersections with at least one member for each
# intersection level or all intersections if the somewhat dangerous
# "show everything" option is TRUE
if(all.intersections) nintersects<-sapply(x,length)
else nintersects<-sapply(x,nNonZero)
# maximum number of intersections in a given level
maxintersections<-max(nintersects)
# largest intersection set in x
maxn<-max(unlist(x))
# default to a minimum spacing of one tenth of the largest intersection set
if(is.na(minspacing)) minspacing<-0.1 * maxn
# x limit that will hold the maximum number of objects and allow
# spacing for the maximum number of intersections in units of objects
maxx<-ifelse(nobjects > objectsums[maxlevel],
nobjects,objectsums[maxlevel] + minspacing * maxintersections)
# have to escape the separator in case it is "+" (default) or
# some other character that means something to some function
attsep<-paste("[",sep,"]",sep="")
# display the empty plot
plot(0,xlim=c(0,maxx),ylim=c(0,nlevels+show.nulls),
main=main,xlab="",ylab="",type="n",axes=FALSE)
# step through each level of intersections
for(level in 1:nlevels) {
# determine the intersect level by the number of elements in the first name
intersectLevel<-length(unlist(strsplit(names(x[[level]][1]),attsep)))
# indices of intersections with at least one object in this level
# or just all of the intersections
if(all.intersections) intersections<-1:nintersects[[level]]
else intersections<-which(x[[level]] > 0)
# get all the names in this level with at least one object
blocknames<-names(x[[level]])[intersections]
# spacing between intersection sets in object units
spacing<-(maxx - objectsums[level])/nintersects[level]
# left edges of the rectangles in x positions
leftx<-c(0,cumsum(x[[level]][intersections] + spacing)) + spacing/2
# now step through the intersections in this level
for(intersect in 1:length(intersections)) {
# check if this intersection is to be displayed
if(matchParts(include,blocknames[intersect])) {
# make the label for the intersection
cellqnt<-ifelse(pct,
paste(round(100*x[[level]][intersections[intersect]]/nobjects,1),
"%",sep=""),x[[level]][intersections[intersect]])
# indices of the colors to use for this rectangle
colindex<-
which(attributes %in% unlist(strsplit(blocknames[intersect],attsep)))
# number of colors
ncol<-length(colindex)
# width of each color slice
xinc<-x[[level]][intersections[intersect]]/ncol
# colors for the slices
slicecol<-col[colindex]
# start at the left edge of the sliced rectangle
offset<-0
# step through the slices
for(slice in 1:ncol) {
# first draw the rectangle with no border
rect(leftx[intersect]+offset,nlevels-level+show.nulls+0.1,
leftx[intersect]+offset+xinc,nlevels-level+show.nulls+0.9,
col=slicecol[slice],border=NA)
# move to the left edge of the next slice
offset<-offset+xinc
}
# draw a box around the sliced rectangle
rect(leftx[intersect],nlevels-level+show.nulls+0.1,
leftx[intersect]+x[[level]][intersections[intersect]],
nlevels-level+show.nulls+0.9)
# display the label for this rectangle
boxed.labels(leftx[intersect]+x[[level]][intersections[intersect]]/2,
nlevels-level+show.nulls+0.5,
paste(blocknames[intersect],cellqnt,sep="\n"),cex=cex)
}
}
}
if(show.nulls) {
# number of objects with no set membership or no attributes
nonset<-as.numeric(nobjects - sum(objectsums))
# left edge of the rectangle
leftnulls<-sum(par("usr")[1:2])/2-nonset/2
# draw the rectangle
if(nonset) rect(leftnulls,0.1,leftnulls+nonset,0.9)
# center of the rectangle
xpos<-leftnulls+nonset/2
# display the label
if(pct) nonset<-paste(round(100*nonset/nobjects,1),"%",sep="")
boxed.labels(xpos,0.5,paste(null.label,nonset,sep="\n"),cex=cex)
}
# restore the original plot parameters
par(mar=oldmar)
# stick the number of objects and attributes back on
x[[length(x) + 1]]<-nobjects
x[[length(x) + 1]]<-attributes
invisible(x)
}
plotrix/R/box.heresy.R 0000644 0001762 0000144 00000002414 14011145766 014373 0 ustar ligges users box.heresy<-function(x,y,uinner,linner,ulim,llim=ulim,
boxwidth=NULL,intervals=FALSE,arrow.cap=NULL,pch=22,main="",xlab="",
ylab="",xaxlab=NULL,col="white",do.first=NULL,...) {
if(missing(y)) {
y<-x
x<-1:length(y)
}
if(missing(llim)) llim<-ulim
if(missing(linner)) linner<-uinner
if(is.null(xaxlab)) xaxlab<-x
# if dispersion is specified in intervals, convert to absolute values
if(intervals) {
ulim<-y+ulim
llim<-y-llim
uinner<-y+uinner
linner<-y-linner
}
if(is.null(boxwidth)) {
if(length(x) > 1) xrange<-range(x)
else xrange<-c(0.5,1.5)
boxwidth<-diff(xrange)/(4*length(x))
xspace<-diff(xrange)/10
xlim<-c(xrange[1]-xspace,xrange[2]+xspace)
}
else {
nboxes<-length(y)
xspace<-min(boxwidth)/4
x<-cumsum(boxwidth*2)+cumsum(rep(xspace,nboxes))
xlim<-c(xspace+boxwidth[1]/2,x[nboxes]+boxwidth[nboxes]+xspace)
}
plot(x,y,xlim=xlim,ylim=range(c(llim,ulim)),main=main,
xlab=xlab,ylab=ylab,type="n",xaxt="n")
if(!is.null(do.first)) eval(parse(text=do.first))
axis(1,at=x,labels=xaxlab)
if(is.null(arrow.cap)) arrow.cap<-boxwidth/diff(par("usr")[1:2])
# upper and lower limits have already been converted
dispersion(x,y,ulim,llim,intervals=FALSE,arrow.cap=arrow.cap,...)
rect(x-boxwidth,linner,x+boxwidth,uinner,col=col)
points(x,y,pch=pch)
}
plotrix/R/clplot.R 0000755 0001762 0000144 00000013123 14011145766 013604 0 ustar ligges users # CLPLOT
# Jan 2014 - Fixed a semibug in the way min/max cut levels are
# generated, also cleaned up some random stuff.
# 20 Oct. 2008 Now plots even pathological data sets without gaps
# Parameters:
# levels-- vector of desired cutpoints. Program will sort them.
# cols-- vector of desired color sequence (strings or numeric references)
# x, y-- The data, of course.
# '...' is intended for arguments to pass to PLOT or LINES calls
# lty-- plot parameter lty (see par() )
# showcuts-- Set to TRUE to plot gridlines at color cut levels
#
clplot<-function(x,y, ylab=deparse(substitute(y)), xlab=deparse(substitute(x)),
levels=seq(min(y)+(max(y)-min(y))/5, max(y)-(max(y)-min(y))/5, length.out=4),
cols=c("black", "blue", "green", "orange", "red"), lty=1, showcuts=FALSE, ...)
{
if(missing(y)){
ylab=xlab # no reason to recalc "deparse(substitute(x))"
y<-as.numeric(x)
x<-seq(1,length(y))
# should have done this long ago: fix xlabel
xlab<-'index'
}
xx<-as.numeric(x)
yy<-as.numeric(y)
levels<-sort(as.numeric(levels))
# Jan 2014: Bugfix here: if levels has values outside min or max of data,
# we do NOT want to creat cuts at the min,max values! And this needs to be done
# PRIOR to checking lengths of levels vs colors; and check against cuts,
# not against levels.
#### new code
cuts<-sort(levels)
if(min(yy)< min(levels) ) cuts<- c(min(yy),cuts)
if(max(yy)> max(levels) ) cuts <- c(cuts, max(yy))
# set cols length to fit with number of cuts. (number of colors to be used)
if (length(cuts)> length(cols)+1) {
cat("Warning: not enough colors. Will repeat.\n")
}
#notice this will also truncate cols if it's longer than number of slices.
cols<-rep(cols,length.out=length(cuts)-1)
#build 'empty' graph
plot(xx,yy,type='n', xlab=xlab, ylab=ylab, ...)
# initialize the list variable which will hold all modded slices
modslice<-list()
newxx<-xx
newyy<-yy
# newxx/yy will add new points as generated for each slice
for(jj in 1 : (length(cuts)-1))
{
botsl<-(cuts[jj]>newyy)
topsl<-(cuts[jj+1]1 )
{
for (i in 1:(length(runs$lengths)-1))
{
thepos<-thepos+runs$lengths[i]
# "add" interp point at the end of each run
# whichway chooses which 'side' of interval to interpolate towards
whichway<-slicelog[thepos]
#pick correct cut value - is subslice is going up or down
#whichcut chooses the cut to use
whichcut<-as.logical(newyy[thepos]>=cuts[j]&newyy[thepos+1]>=cuts[j])
#note the interpolation is TO x FROM y
xint3<-approx(c(newyy[thepos:(thepos+1)]),c(newxx[thepos:(thepos+1)]),cuts[j+whichcut])
newx <-xint3$y
newy <-cuts[j+whichcut]
# adding in "i-1" to the splitpoint to get correct location
slx<-c(slx[1:(thepos+(i-1))],newx,slx[(thepos+1+(i-1)):length(slx)])
sly<-c(sly[1:(thepos+(i-1))],newy,sly[(thepos+1+(i-1)):length(sly)])
} #end of for (runs) loop; all necessary points have been added
} # end of if (length(runs))
modslice<-c(modslice,list(cbind(slx,sly)))
names(modslice)<-c(names(modslice)[1:(length(names(modslice))-1)],paste("newsl",j,sep=""))
} # end of j loop.
# modslice will have one list element for each slice, empty or not
mapply(function(x,y) suppressWarnings(lines(x[,1],x[,2], col=y, type='l', lty=lty,...)), modslice,cols)
#suppression lets me pass '...' to both plot and lines calls, e.g. titles to plot() above
if(showcuts==TRUE)
{
lnx<-c(min(newxx),max(newxx))
lncut<-cuts[2:(length(cuts)-1)]
mapply(function(rrr,sss) lines(lnx,c(rrr,sss),lty='dotted', col='black'),lncut,lncut)
} #end of showcuts IF
#save interesting stuff
stuff<-list(xin=x,yin=y,cuts=cuts)
stuff<-c(stuff,modslice)
names(stuff)<-c('xin','yin','cuts',names(modslice))
return(invisible(stuff))
}
plotrix/R/smoothColors.R 0000755 0001762 0000144 00000002736 14011145766 015012 0 ustar ligges users smoothColors<-function(...,alpha=NA){
args <- list(...)
r <- g <- b <- NULL
while(length(args) > 0) {
if(!is.character(args[[1]]))
stop("Usage: smoothColors(\"color name\",[n|\"color name\"],...,\"color name\")")
arglen<-length(args)
if(arglen > 1){
if(is.numeric(args[[2]])){
lastarg<-2
# args[[lastarg]] should be a color name
while(is.numeric(args[[lastarg]])) {
lastarg<-lastarg+1
# make sure that there are enough arguments left
if(lastarg > arglen) stop("bad argument list")
}
## do interpolate:
from <- col2rgb(args[[1]])
too <- col2rgb(args[[lastarg]])
## generate args[[2]] colors between specified colors:
n <- args[[2]]+2 # add 2 for start and finish
## chop off last one since it will be added on the next iteration:
r <- c(r,seq(from[1,],too[1,],length=n))
i <- length(r)
r <- r[-i]
g <- c(g,seq(from[2,],too[2,],length=n))
g <- g[-i]
b <- c(b,seq(from[3,],too[3,],length=n))
b <- b[-i]
## cut color and n from list and back we go
args <- args[-(1:(lastarg-1))]
}
else {
## insert color, chop off 1
cc <- col2rgb(args[[1]])
r <- c(r,cc[1,])
g <- c(g,cc[2,])
b <- c(b,cc[3,])
args <- args[-1]
}
}
else {
## insert color, chop off 1
cc <- col2rgb(args[[1]])
r <- c(r,cc[1,])
g <- c(g,cc[2,])
b <- c(b,cc[3,])
args <- args[-1]
}
}
if(is.na(alpha)) rgb(r,g,b,maxColorValue=255)
else rgb(r,g,b,alpha=alpha,maxColorValue=255)
}
plotrix/R/getMarginWidth.R 0000755 0001762 0000144 00000001634 14011145766 015230 0 ustar ligges users getMarginWidth<-function(side=4,labels,is.legend=FALSE) {
currentmar<-par("mar")
currentpin<-par("pin")[1]
currentfin<-par("fin")[1]
currentusr<-par("usr")
if(is.legend) marwidth<-1.2*legend(0,0,labels,fill=NA,plot=FALSE)$rect$w
else marwidth<-1.1*max(strwidth(labels))
marprop<-ifelse(side==2,currentmar[2]/(currentmar[2]+currentmar[4]),
currentmar[4]/(currentmar[2]+currentmar[4]))*(currentfin-currentpin)/currentfin
plotprop<-currentpin/currentfin
plotwidth<-currentusr[2]-currentusr[1]
marusr<-(marprop/plotprop)*plotwidth
newmar<-ifelse(side==2,currentmar[2],currentmar[4])*marwidth/marusr
cat("plotprop",plotprop,"marprop",marprop,"plotwidth",
plotwidth,"marwidth",marwidth,"\n")
marcenter<-currentusr[2]+marwidth/2
if(marwidth>plotwidth) {
warning("figure size too small for new margin!")
newmar<-ifelse(side==2,currentmar[2],currentmar[4])
}
return(list(newmar=newmar,marcenter=marcenter))
}
plotrix/R/multivari.R 0000644 0001762 0000144 00000022726 14011145766 014331 0 ustar ligges users multivari <- function(var, fac1, fac2, fac3=NULL, fac4=NULL, data,
sort=FALSE, fun=mean, pch=list(15, 16, 17),
col=list("black", "blue","red"), col0="black",
cex=1, fac.cex=2, xlab.depth=3, legend=FALSE,
main=paste("multivari chart of", var), add=FALSE, ...){
## if fac4 is given, make two separate multivaricharts for fac1 to fac3
## on the same y scale
## fac4 only allowed if there is also fac3
## x a data frame
## fac1 to fac4 character strings as names of categorical variables
## these are coerced to factor, if they are not factors yet
## if sort=FALSE, the order of appearance in unique() is used for level order,
## else levels are ordered in the default way of factor
## nfac (calculated) is the number of non-NULL factors
## pch and col are lists of length 2 or 3
## (depending on the number of factors)
## elements can be unique symbol/color specifications
## or vectors of symbol/color specifications for the levels of
## fac1, fac2, or fac3 resp. (fac4 is in separate charts)
## Usually, one would need to specify a pch vector for the last factor,
## in case of more than two factors.
## line colors are taken from the symbol colors of the previous level
## (try out whether this makes sense)
## fac.cex is a factor to enlarge the points versus the text
## xlab.depth gives the highest level for which the horizontal axis
## carries labels for the factor levels
## Changes Dec 8:
## bug fix: colors and symbols did not work correctly,
## if some levels do not occur in the data;
## now, colors and symbols are always picked according to factor levels
## added extra space for legend on horizontal axis
## added an add option (for adding to otherwise prepared plotting template)
## modified initial plot call:
## more logical choice for x and y, which should not change anything
## added cex.axis=cex and cex.lab=cex,
## so that y-axis labeling is also affected by cex
## added/modified/removed some comment text
stopifnot(is.data.frame(data))
nc <- ncol(data)
if (is.numeric(fac1)) {
stopifnot(fac1 %in% 1:nc)
fac1 <- names(data)[fac1]
}
if (is.numeric(var)){
stopifnot(var %in% 1:nc)
var <- names(data)[var]
}
if (is.numeric(fac2)){
stopifnot(fac2 %in% 1:nc)
fac2 <- names(data)[fac2]
}
if (is.numeric(fac3)){
stopifnot(fac3 %in% 1:nc)
fac3 <- names(data)[fac3]
}
if (is.numeric(fac4)){
stopifnot(fac4 %in% 1:nc)
fac4 <- names(data)[fac4]
}
stopifnot(is.character(var))
stopifnot(var %in% names(data))
stopifnot(is.numeric(data[[var]]))
fn <- c(fac1, fac2, fac3, fac4)
if (any(!is.character(fn))) stop("fac1 to fac4 must be character or NULL")
if (any(!fn %in% names(data))) stop("fac1 to fac4 must be variable names in data")
## all factors are columns of data or NULL
## make non-factors into factors
## if (!sort), respect level ordering as encountered in the data
## sort does not touch level ordering in factors
nfac <- 2
if (!sort){
if (!is.factor(data[[fac1]])) data[[fac1]] <- factor(data[[fac1]], levels=unique(data[[fac1]]))
if (!is.factor(data[[fac2]])) data[[fac2]] <- factor(data[[fac2]], levels=unique(data[[fac2]]))
if (!is.null(fac3)){
nfac <- 3
if (!is.factor(data[[fac3]])) data[[fac3]] <- factor(data[[fac3]], levels=unique(data[[fac3]]))
if (!is.null(fac4)){
nfac <- 4
if (!is.factor(data[[fac4]])) data[[fac4]] <- factor(data[[fac4]], levels=unique(data[[fac4]]))
}
}
}
else{
if (!is.factor(data[[fac1]])) data[[fac1]] <- factor(data[[fac1]])
if (!is.factor(data[[fac2]])) data[[fac2]] <- factor(data[[fac2]])
if (!is.null(fac3)){
nfac <- 3
if (!is.factor(data[[fac3]])) data[[fac3]] <- factor(data[[fac3]])
if (!is.null(fac4)){
nfac <- 4
if (!is.factor(data[[fac4]])) data[[fac4]] <- factor(data[[fac4]])
}
}
}
stopifnot(is.list(col))
stopifnot(is.list(pch))
stopifnot(length(col)>=min(3, nfac))
stopifnot(length(pch)>=min(3, nfac))
## the number of observations behind the aggregated values
aggrn <- as.data.frame(table(data[fn][!is.na(data[[var]]),]))
aggrn <- aggrn[!aggrn$Freq==0,]
## for ylim and lowest level
aggr <- aggregate(data[var], data[fn], fun)
names(aggr)[nfac+1] <- var
aggr <- merge(aggr, aggrn, by=fn)
ylim <- range(aggr[[var]]) ## for all chunks of the chart
## now we have the data structure, nfac factors and one value
if (nfac==4) {
dat_split <- split(data, data[[fac4]])
}
else {
dat_split <- list(data)
}
npanel <- length(dat_split)
xlim <- c(0.5, (nlevels(data[[fac1]])+1)*npanel+legend)
## within each panel, use x positions 1 to nlevels(dat[[fac1]])
## continue from these with x positions at most +/-0.25
## and then with x positions at most +/- 0.1
aggrlists <- lapply(dat_split, function(obj){
hilf <- list(aggregate(obj[var], obj[fac1], fun),
aggregate(obj[var], obj[c(fac1, fac2)], fun))
if (nfac >= 3) hilf[[3]] <- aggregate(obj[var], obj[c(fac1, fac2, fac3)], fun)
hilf
})
nlevs <- sapply(data[fn], nlevels)
poscalc <- function(i){
## calculate x positions
## i is the panel
pos3 <- NULL
pos1 <- 1:nlevs[1] + (nlevs[1] + 1) * (i - 1)
pos2 <- rep(pos1, nlevs[2]) +
0.5*rep((0:(nlevs[2]-1) - (nlevs[2]-1)/2)/(nlevs[2] - 1),
each=length(pos1))
if (nfac >= 3) pos3 <- rep(pos2, nlevs[3]) +
0.2*rep((0:(nlevs[3]-1) - (nlevs[3]-1)/2)/(nlevs[3] - 1),
each=length(pos2))
## take care of missing levels
## the number of observations behind the aggregated values
aggrn1 <- as.data.frame(table(dat_split[[i]][fac1][!is.na(data[[var]]),]))
pos1 <- pos1[aggrn1$Freq>0]
aggrn2 <- as.data.frame(table(dat_split[[i]][c(fac1,fac2)][!is.na(data[[var]]),]))
pos2 <- pos2[aggrn2$Freq>0]
if (nfac>=3){
aggrn3 <- as.data.frame(table(dat_split[[i]][c(fac1,fac2,fac3)][!is.na(data[[var]]),]))
pos3 <- pos3[aggrn3$Freq>0]
}
mapply(cbind, aggrlists[[i]], list(pos1=pos1,pos2=pos2,pos3=pos3)[1:min(nfac, 3)])
}
## functions to draw each element of aggrlists in its place
linesfun <- function(x, ...){
lines()
}
pch <- as.list(pch)
col <- as.list(col)
for (i in 1:min(3, nfac))
if (length(pch[[i]]) < nlevs[i]) pch[[i]] <- rep(pch[[i]],nlevs[i])
for (i in 1:min(3, nfac))
if (length(col[[i]]) < nlevs[i]) col[[i]] <- rep(col[[i]],nlevs[i])
## now, pch and col are lists with a level for each
calcresults <- lapply(1:npanel, function(obj){
hilf <- poscalc(obj)
hilf <- lapply(hilf, function(obj) {
names(obj)[ncol(obj)] <- "x"
obj
}
)
hilf
})
## prepare plot
if (!add) plot(xlim,ylim,type="n", xaxt="n", xlab="", ylab=var, tcl=0.5,
xlim=xlim, ylim=ylim, main=main, cex.axis=cex, cex.lab=cex, ...)
for (i in 1:npanel){
plotlist <- calcresults[[i]]
## last column of each list element holds x-position
## last but one column (name var) holds y value
tit <- ""
if (nfac==4) tit <- paste(fac4, "=", levels(data[[fac4]])[i])
for (j in 1:length(plotlist)){
## jth hierarchy level
dd <- plotlist[[j]]
if (j==1) {
lines(dd$x, dd[[var]], col=col0, ...)
points(dd$x, dd[[var]], col=col[[1]][as.numeric(dd[[fac1]])],
pch=pch[[1]][as.numeric(dd[[fac1]])], cex=fac.cex*cex, ...)
mtext(side=3, at=mean(dd$x), text=tit, line=0, cex=1.5*cex, ...)
mtext(side=1, at=dd$x, line=0, levels(data[[fac1]]), cex=cex, ...)
mtext(side=1, at=xlim[2], line=0, fac1, cex=cex, adj=1, ...)
}
else {
## not first level of hierarchy
## hilf contains separate portions for each level of fac1 to facj-1
hilf <- split(dd, dd[fn[1:(j-1)]])
if (xlab.depth >= j){
mtext(side=1, at=dd$x, line=j-1, dd[[fn[j]]], cex=cex, ...)
mtext(side=1, at=xlim[2], line=j-1, fn[j], cex=cex, adj=1, ...)
}
for (ii in 1:length(hilf)){
dd <- hilf[[ii]]
## color from previous hierarchy level
lines(dd$x, dd[[var]],
col=col[[j-1]][as.numeric(dd[[fn[j-1]]])[1]], ...)
## point symbol and color from current hierarchy level
points(dd$x, dd[[var]], cex=fac.cex*cex,
col=col[[j]][as.numeric(dd[[fn[j]]])],
pch=pch[[j]][as.numeric(dd[[fn[j]]])], ...)
}
}
}
}
if (legend){
## check whether legend makes sense
## (col and/or pch for last level defined as vector)
## add legend at the bottom right
pick <- 3
if (nfac<3) pick <- 2
if (length(col[[pick]])==1 && length(pch[[pick]])==1)
warning("no legend created, because symbols are not distinct")
else{
lastval <- dd[[var]][which.max(dd$x)]
lpos <- "bottomright"
if (lastval < mean(ylim)) lpos <- "topright"
legend(lpos, legend=levels(data[[fn[pick]]]),
pch=pch[[pick]], col=col[[pick]], cex=0.5*fac.cex*cex,
title=fn[pick])
}
}
invisible(calcresults)
}
plotrix/R/revaxis.R 0000755 0001762 0000144 00000002166 14011145766 013775 0 ustar ligges users # Function revaxis --- rev for ``reverse'' (to reverse the direction of
# axes).
#
# Written by T. Rolf Turner, University of New Brunswick (now
# with the Starpath Project, Universtiy of Auckland).
#
# Some bugs fixed 7/2/02, with the assistance of Herberto Ghezzo
# of McGill University.
#
revaxis<-function(x,y,xrev=FALSE,yrev=TRUE,xside=if(yrev) 3 else 1,
yside=if(xrev) 4 else 2,xlab=NULL,ylab=NULL,bty=NULL,...) {
xname <- if(is.null(xlab)) deparse(substitute(x)) else xlab
yname <- if(is.null(ylab)) deparse(substitute(y)) else ylab
xlab <- if(yrev) "" else xname
ylab <- if(xrev) "" else yname
y1 <- if(yrev) -y else y
x1 <- if(xrev) -x else x
old.mar <- par()$mar
on.exit(par(mar = old.mar))
par(mar = old.mar[c(xside, yside, 4 - xside, 6 - yside)])
plot(x1, y1, axes = FALSE, xlab = xlab, ylab = ylab, ...)
if(xrev) {
axis(xside, at = pretty(-x), labels = rev(pretty(x)))
mtext(side = yside, line = 2, text = yname)
}
else axis(xside)
if(yrev) {
axis(yside,at=pretty(-y),labels=rev(pretty(y)),srt=90)
mtext(side=xside,line=3,text=xname)
}
else axis(yside)
if(!is.null(bty)) box(bty = bty)
invisible()
}
plotrix/R/pie3D.R 0000755 0001762 0000144 00000010757 14011145766 013265 0 ustar ligges users pie3D.labels<-function(radialpos,radius=1,height=0.1,theta=pi/6,
labels,labelcol=par("fg"),labelcex=1.5,labelrad=1.25,minsep=0.3){
oldcex<-par("cex")
nlab<-length(labels)
par(cex=labelcex,xpd=TRUE)
for (i in 1:nlab) {
if(i < nlab) {
labelsep<-radialpos[i+1] - radialpos[i]
if(labelsep < minsep) {
radialpos[i]<-radialpos[i]+(labelsep-minsep)/2
radialpos[i+1]<-radialpos[i+1]-(labelsep-minsep)/2
}
}
xpos<-labelrad * radius * cos(radialpos[i])
offset<-(radialpos[i] > pi && radialpos[i] < 2 * pi) * height
ypos<-labelrad * radius * sin(radialpos[i]) * 2 * theta/pi +
sin(radialpos[i]) * height
text(xpos,ypos,labels[i],col=labelcol,
adj=c(0.5,abs(0.5-sin(radialpos[i])/2)))
}
par(cex=oldcex,xpd=FALSE)
}
draw.tilted.sector<-function(x=0,y=0,edges=NA,radius=1,height=0.1,
theta=pi/6,start=0,end=pi*2,border=par("fg"),col=par("bg"),explode=0,
shade=0.8) {
if(is.na(edges)) edges<-trunc(20*(end-start))
angleinc<-(end-start)/edges
angles<-c(seq(start,end,by=angleinc),end)
viscurve<-(angles>=pi)&(angles<=2*pi)
nv<-length(angles)
bisector<-(start+end)/2
if(explode){
# calculate the x and y offsets for the explode
x<-x+cos(bisector)*explode
y<-y+sin(bisector)*(1-sin(theta))*explode
}
if(shade>0 && shade<1){
# calculate the shade color for the sides of the sector
rgbcol<-col2rgb(col)
shadecol<-rgb(shade*rgbcol[1]/255,shade*rgbcol[2]/255,
shade*rgbcol[3]/255)
}
else shadecol<-col
xp<-cos(angles) * radius + x
# this is the top of the sector
yp<-sin(angles) * 2 * theta/pi * radius + y
if(start > 3*pi/2) {
# the 'left' side will be visible in this quadrant
if(explode > 0)
# display the 'right' side just in case it goes beyond pi/2
polygon(c(xp[nv],x,x,xp[nv],xp[nv]),c(yp[nv]-height,y-height,
y+height,yp[nv]+height,yp[nv]+height),border=border,
col=shadecol)
# display the 'outside' of the sector
polygon(c(xp[viscurve],rev(xp[viscurve])),c(yp[viscurve]-height,
rev(yp[viscurve])+height),border=border,col=shadecol)
if(explode > 0)
# display the 'left' (front) side
polygon(c(xp[1],x,x,xp[1],xp[1]),c(yp[1]-height,y-height,
y+height,yp[1]+height,yp[1]),border=border,
col=shadecol)
}
else {
if(start > pi/2) {
if(explode > 0) {
polygon(c(xp[1],x,x,xp[1],xp[1]),c(yp[1]-height,y-height,
y+height,yp[1]+height,yp[1]),border=border,
col=shadecol)
polygon(c(xp[nv],x,x,xp[nv],xp[nv]),c(yp[nv]-height,
y-height,y+height,yp[nv]+height,yp[nv]+height),
border=border,col=shadecol)
}
if(end > pi)
polygon(c(xp[viscurve],rev(xp[viscurve])),c(yp[viscurve]-height,
rev(yp[viscurve])+height),border=border,
col=shadecol)
}
else {
if(end > pi || start<2*pi)
polygon(c(xp[viscurve],rev(xp[viscurve])),c(yp[viscurve]-height,
rev(yp[viscurve])+height),border=border,
col=shadecol)
if(end > pi/2 && end < 3*pi/2 && explode > 0){
polygon(c(xp[nv],x,x,xp[nv],xp[nv]),c(yp[nv]-height,
y-height,y+height,yp[nv]+height,yp[nv]+height),
border=border,col=shadecol)
}
if(explode > 0)
polygon(c(xp[1],x,x,xp[1],xp[1]),c(yp[1]-height,y-height,
y+height,yp[1]+height,yp[1]+height),border=border,
col=shadecol)
}
}
#display the top
polygon(c(xp,x),c(yp+height,y+height),border=border,col=col)
return(bisector)
}
pie3D<-function(x,edges=NA,radius=1,height=0.1,theta=pi/6,
start=0,border=par("fg"),col=NULL,labels=NULL,labelpos=NULL,
labelcol=par("fg"),labelcex=1.5,sector.order=NULL,explode=0,
shade=0.8,mar=c(4,4,4,4),pty="s",...) {
if(!is.numeric(x) || any(x < 0))
stop("pie3D: x values must be positive numbers")
# drop NAs
if(any(is.na(x))) x<-x[!is.na(x)]
oldmar<-par("mar")
par(pty=pty,mar=mar,xpd=TRUE)
x<-c(0, cumsum(x)/sum(x))*2*pi+start
nsectors<-length(x)-1
if(is.null(col)) col <- rainbow(nsectors)
else if(length(col) < nsectors) col<-rep(col,length.out=nsectors)
if(is.null(sector.order))
# get the order of drawing sectors
sector.order<-
order(sin((x[2:(nsectors+1)]+x[1:nsectors])/2),decreasing=TRUE)
bc<-rep(0,nsectors)
# set up an empty plot
plot(0,xlab="",ylab="",xlim=c(-1,1),ylim=c(-1,1),type="n",axes=FALSE,...)
for(i in sector.order) {
bc[i]<-draw.tilted.sector(radius=radius,height=height,
theta=theta,start=x[i],end=x[i+1],edges=edges,
border=border,col=col[i],explode=explode,shade=shade)
}
if(!is.null(labels)) {
if(!is.null(labelpos))
bc<-labelpos
pie3D.labels(bc,height=height,theta=theta,
labels=labels,labelcol=labelcol,labelcex=labelcex)
}
par(mar=oldmar,xpd=FALSE,pty="m")
invisible(bc)
}
plotrix/R/sizetree.R 0000755 0001762 0000144 00000007100 14100705335 014130 0 ustar ligges users sizetree<-function (x, left = 0, top, right = 1, lastcenter = NA,
showval = TRUE, showcount = TRUE, stacklabels = TRUE, firstcall = TRUE,
col = NULL, border = NA, toplab = NULL, base.cex = 1, ...)
{
dimx <- dim(x)
colname <- names(x)[1]
if (firstcall) {
x <- x[do.call(order, x), ]
oldmar <- par("mar")
par(mar = c(1, 2, 2, 1))
top <- sum(!is.na(x[, 1]))
if (top < dimx[1])
cat(dimx[1] - top, "NA values dropped from first stack.\n")
plot(0, xlim = c(0, dimx[2]), ylim = c(0, top), type = "n",
axes = FALSE, xlab = "", ylab = "", ...)
}
xfreq <- table(x[, 1])
lenxf <- length(xfreq)
if (firstcall) {
if (is.null(col)) {
col <- list()
for (index in 1:dimx[2]) col[[index]] <- rainbow(length(table(x[,
index])))
}
for (index in 1:dimx[2]) if (is.null(names(col[[index]])))
names(col[[index]]) <- names(table(x[, index]))
}
if (lenxf) {
if (is.list(col)) {
barcol <- col[[1]]
barcol <- barcol[names(col[[1]]) %in% names(xfreq)]
}
else barcol <- col[names(col) %in% names(xfreq)]
labels <- names(xfreq)
squeeze <- (right - left)/10
for (bar in 1:lenxf) {
if (length(xfreq[bar])) {
if (!is.na(xfreq[bar])) {
if (xfreq[bar] > 0) {
rect(left + squeeze, top - xfreq[bar], right -
squeeze, top, col = barcol[bar], border = border)
labelheight <- strheight(labels[bar])
cex <- ifelse((1.5 * labelheight) > xfreq[bar],
base.cex * 0.75 * xfreq[bar]/labelheight,
base.cex)
if (showval) {
textcol <- ifelse(colSums(col2rgb(unlist(barcol[bar])) *
c(1.4, 1.4, 0.5)) < 350, "white", "black")
bartext <- ifelse(showcount, paste(labels[bar],
" (", xfreq[bar], ")", sep = ""), labels[bar])
text((left + right)/2, top - xfreq[bar]/2,
bartext, cex = cex, col = textcol)
}
if (!is.na(lastcenter))
segments(left + squeeze, top - xfreq[bar]/2,
left - squeeze, lastcenter)
xvalue <- ifelse(is.numeric(x[, 1]), as.numeric(labels[bar]),
labels[bar])
if (dimx[2] > 1) {
newcol <- col
newcol[[1]] <- NULL
nextx <- subset(x, x[, 1] == xvalue, 2:dimx[2])
sizetree(nextx, right, top, right + 1,
lastcenter = top - xfreq[bar]/2, showval = showval,
showcount = showcount, stacklabels = stacklabels, firstcall = FALSE,
col = newcol, border = border, base.cex = base.cex)
}
}
}
}
top <- top - xfreq[bar]
}
if (stacklabels)
mtext(colname, side = 1, at = (left + right)/2, line = -0.4)
}
if (firstcall) {
if (!is.null(toplab)) {
par(xpd = TRUE)
top <- sum(!is.na(x[, 1]))
text(0.5:(dimx[2] + 0.5), 1.01 * top, toplab, adj = c(0.5,
0))
par(xpd = FALSE)
}
par(mar = oldmar)
}
}
plotrix/R/rescale.R 0000755 0001762 0000144 00000001310 14011145766 013720 0 ustar ligges users # linearly transforms a vector or matrix of numbers to a new range
rescale<-function(x,newrange) {
if(missing(x) | missing(newrange)) {
usage.string<-paste("Usage: rescale(x,newrange)\n",
"\twhere x is a numeric object and newrange is the new min and max\n",
sep="",collapse="")
stop(usage.string)
}
if(is.numeric(x) && is.numeric(newrange)) {
xna<-is.na(x)
if(all(xna)) return(x)
if(any(xna)) xrange<-range(x[!xna])
else xrange<-range(x)
# if x is constant, just return it
if(xrange[1] == xrange[2]) return(x)
mfac<-(newrange[2]-newrange[1])/(xrange[2]-xrange[1])
return(newrange[1]+(x-xrange[1])*mfac)
}
else {
warning("Only numeric objects can be rescaled")
return(x)
}
}
plotrix/R/textbox.R 0000755 0001762 0000144 00000003414 14011145766 014006 0 ustar ligges users textbox<-function(x,y,textlist,justify=c("l","c","r"),cex=1,leading=0.5,
box=TRUE,adj=c(0,0),font=NULL,vfont=NULL,col=NULL,border=NULL,fill=NA,
density=NULL,angle=45,lty=par("lty"),lwd=par("lwd"),margin=0) {
if (length(margin) == 1) margin<-rep(margin, 4)
else if (length(margin) == 2) margin<-rep(margin, 2)
saveAdj<-par(adj = 0)
textstr<-paste(textlist, collapse=" ")
words<-strsplit(textstr," ")[[1]]
line.height<-strheight("hy",cex=cex,font=font,vfont=vfont) * (1+leading)
if(margin[2] > 0) x[1]<-x[1] + margin[2]
if(margin[3] > 0) y<-y-margin[3]
if(margin[4] > 0) x[2]<-x[2]-margin[4]
if(x[1] >= x[2]) x[2]<-x[1]+diff(par("usr")[1:2])*0.1
x.len<-diff(x)
y.pos<-y
x.pos<-x[1]
adj2<-c(0,1)
if(justify[1] == "c") {
x.pos<-x.pos + x.len/2
adj2[1]<-0.5
}
else {
if(justify[1] == "r") {
x.pos<-x.pos + x.len
adj2[1]<-1
}
}
curword<-1
curline<-1
txtline<-""
while(curword <= length(words)) {
txtline[curline]<- ""
txtline[curline]<-paste(txtline[curline],words[curword])
curword<-curword + 1
while(strwidth(paste(txtline[curline],words[curword]),cex=cex,
font=font,vfont=vfont) < x.len && !is.na(words[curword])) {
txtline[curline]<-paste(txtline[curline],words[curword])
curword<-curword+1
}
curline<-curline+1
y.pos[curline]<-y.pos[curline-1]-line.height
}
if(box) {
xbox<-x
ybox<-c(y.pos[curline],y)
ybox[1]<-ybox[1]-abs(margin[1])
xbox[1]<-xbox[1]-abs(margin[2])
ybox[2]<-ybox[2]+abs(margin[3])
xbox[2]<-xbox[2]+abs(margin[4])
rect(xbox[1],ybox[1],xbox[2],ybox[2],border=border,
col=fill,density=density,angle=angle,lty=lty,lwd=lwd)
}
text(x.pos,y.pos[1:curline-1],txtline,adj=adj+adj2,cex=cex,
col=col,font=font,vfont=vfont)
par(saveAdj)
return(y.pos)
}
plotrix/R/axis.break.R 0000755 0001762 0000144 00000007126 14011145766 014344 0 ustar ligges users # axis.break places a break marker at the position "breakpos"
# in user coordinates on the axis nominated - see axis().
axis.break<-function(axis=1,breakpos=NULL,pos=NULL,bgcol="white",breakcol="black",
style="slash",brw=0.02) {
# get the coordinates of the outside of the plot
figxy<-par("usr")
# flag if either axis is logarithmic
xaxl<-par("xlog")
yaxl<-par("ylog")
# calculate the x and y offsets for the break
xw<-(figxy[2]-figxy[1])*brw
yw<-(figxy[4]-figxy[3])*brw
if(!is.null(pos)) figxy<-rep(pos,4)
# if no break position was given, put it just off the plot origin
if(is.null(breakpos))
breakpos<-ifelse(axis%%2,figxy[1]+xw*2,figxy[3]+yw*2)
if(xaxl && (axis == 1 || axis == 3)) breakpos<-log10(breakpos)
if(yaxl && (axis == 2 || axis == 4)) breakpos<-log10(breakpos)
# set up the "blank" rectangle (left, bottom, right, top)
switch(axis,
br<-c(breakpos-xw/2,figxy[3]-yw/2,breakpos+xw/2,figxy[3]+yw/2),
br<-c(figxy[1]-xw/2,breakpos-yw/2,figxy[1]+xw/2,breakpos+yw/2),
br<-c(breakpos-xw/2,figxy[4]-yw/2,breakpos+xw/2,figxy[4]+yw/2),
br<-c(figxy[2]-xw/2,breakpos-yw/2,figxy[2]+xw/2,breakpos+yw/2),
stop("Improper axis specification."))
# get the current setting of xpd
old.xpd<-par("xpd")
# don't cut the break off at the edge of the plot
par(xpd=TRUE)
# correct for logarithmic axes
if(xaxl) br[c(1,3)]<-10^br[c(1,3)]
if(yaxl) br[c(2,4)]<-10^br[c(2,4)]
if(style == "gap") {
if(xaxl) {
figxy[1]<-10^figxy[1]
figxy[2]<-10^figxy[2]
}
if(yaxl) {
figxy[3]<-10^figxy[3]
figxy[4]<-10^figxy[4]
}
# blank out the gap area and calculate the line segments
if(axis == 1 || axis == 3) {
rect(breakpos,figxy[3],breakpos+xw,figxy[4],col=bgcol,border=bgcol)
xbegin<-c(breakpos,breakpos+xw)
ybegin<-c(figxy[3],figxy[3])
xend<-c(breakpos,breakpos+xw)
yend<-c(figxy[4],figxy[4])
if(xaxl) {
xbegin<-10^xbegin
xend<-10^xend
}
}
else {
rect(figxy[1],breakpos,figxy[2],breakpos+yw,col=bgcol,border=bgcol)
xbegin<-c(figxy[1],figxy[1])
ybegin<-c(breakpos,breakpos+yw)
xend<-c(figxy[2],figxy[2])
yend<-c(breakpos,breakpos+yw)
if(xaxl) {
xbegin<-10^xbegin
xend<-10^xend
}
}
# clip the lines
par(xpd=TRUE)
}
else {
# draw the "blank" rectangle
rect(br[1],br[2],br[3],br[4],col=bgcol,border=bgcol)
if(style == "slash") {
# calculate the slash ends
if(axis == 1 || axis == 3) {
xbegin<-c(breakpos-xw,breakpos)
xend<-c(breakpos,breakpos+xw)
ybegin<-c(br[2],br[2])
yend<-c(br[4],br[4])
if(xaxl) {
xbegin<-10^xbegin
xend<-10^xend
}
}
else {
xbegin<-c(br[1],br[1])
xend<-c(br[3],br[3])
ybegin<-c(breakpos-yw,breakpos)
yend<-c(breakpos,breakpos+yw)
if(yaxl) {
ybegin<-10^ybegin
yend<-10^yend
}
}
}
else {
# calculate the zigzag ends
if(axis == 1 || axis == 3) {
xbegin<-c(breakpos-xw/2,breakpos-xw/4,breakpos+xw/4)
xend<-c(breakpos-xw/4,breakpos+xw/4,breakpos+xw/2)
ybegin<-c(ifelse(yaxl,10^figxy[3+(axis==3)],figxy[3+(axis==3)]),br[4],br[2])
yend<-c(br[4],br[2],ifelse(yaxl,10^figxy[3+(axis==3)],figxy[3+(axis==3)]))
if(xaxl) {
xbegin<-10^xbegin
xend<-10^xend
}
}
else {
xbegin<-c(ifelse(xaxl,10^figxy[1+(axis==4)],figxy[1+(axis==4)]),br[1],br[3])
xend<-c(br[1],br[3],ifelse(xaxl,10^figxy[1+(axis==4)],figxy[1+(axis==4)]))
ybegin<-c(breakpos-yw/2,breakpos-yw/4,breakpos+yw/4)
yend<-c(breakpos-yw/4,breakpos+yw/4,breakpos+yw/2)
if(yaxl) {
ybegin<-10^ybegin
yend<-10^yend
}
}
}
}
# draw the segments
segments(xbegin,ybegin,xend,yend,col=breakcol,lty=1)
# restore xpd
par(xpd=FALSE)
}
plotrix/R/rectFill.R 0000755 0001762 0000144 00000002164 14011145766 014056 0 ustar ligges users rectFill<-function(x1,y1,x2,y2,fg=par("fg"),bg=par("bg"),xinc=NA,yinc=NA,
pch=1,pch.cex=1,pch.col=par("fg"),...) {
if(is.na(xinc[1])) xinc<-strwidth(pch,cex=pch.cex)
if(is.na(yinc[1])) yinc<-strheight(pch,cex=pch.cex)
nrect<-length(x1)
if(length(fg) < nrect) fg<-rep(fg,nrect)
if(length(bg) < nrect) bg<-rep(bg,nrect)
if(length(xinc) < nrect) xinc<-rep(xinc,nrect)
if(length(yinc) < nrect) yinc<-rep(yinc,nrect)
if(length(pch) < nrect) pch<-rep(pch,nrect)
if(length(pch.cex) < nrect) pch.cex<-rep(pch.cex,nrect)
if(length(pch.col) < nrect) pch.col<-rep(pch.col,nrect)
for(frect in 1:nrect) {
rect(x1[frect],y1[frect],x2[frect],y2[frect],col=bg[frect],border=fg[frect])
if(yinc[frect] > 0) {
xpos<-seq(x1[frect]+xinc[frect]/2,x2[frect]+xinc[frect]/2,by=xinc[frect])
lenxpos<-length(xpos)
ypos<-seq(y1[frect]+yinc[frect]/2,y2[frect]+yinc[frect],by=yinc[frect])
lenypos<-length(ypos)
xpos<-rep(xpos,each=lenypos)
ypos<-rep(ypos,lenxpos)
clip(x1[frect],x2[frect],y1[frect],y2[frect])
points(xpos,ypos,pch=pch[frect],cex=pch.cex[frect],col=pch.col[frect],...)
}
}
do.call(clip,as.list(par("usr")))
}
plotrix/R/histStack.R 0000644 0001762 0000144 00000002345 14011145766 014245 0 ustar ligges users histStack<-function(x,...) {
UseMethod("histStack")
}
histStack.formula<-function(x,data,breaks="Sturges",col="rainbow",right=TRUE,
main="",xlab=NULL,legend.pos=NULL,cex.legend=0.75,...) {
mf<-model.frame(x,data=data)
if(is.null(xlab)) xlab<-names(mf)[1]
histStack.default(mf[,1],mf[,2],breaks=breaks,col=col,right=right,
main=main,xlab=xlab,legend.pos=legend.pos,cex.legend=cex.legend,...)
}
histStack.default<-function(x,z,breaks="Sturges",col="rainbow",right=TRUE,
main="",xlab=NULL,legend.pos=NULL,cex.legend=0.75,...) {
if(!is.factor(z)) {
z<-factor(z)
warning("z was converted to a factor")
}
seps=levels(z)
numseps<-length(seps)
if(length(col) == 1) col<-do.call(col,list(n=numseps))
if(length(col) < numseps) col<-rep(col,length.out=numseps)
if(!is.numeric(x)) stop("x must be numeric",call.=FALSE)
# plot the histogram of all x
hS<-hist(x,breaks=breaks,col=col[1],right=right,main=main,xlab=xlab,...)
# plot the remaining
for(i in 1:(numseps-1))
hist(x[z %in% seps[-(1:i)]],breaks=hS$breaks,col=col[i+1],
right=right,add=TRUE)
if(!is.null(legend.pos)) {
if(length(legend.pos > 1))
legend(legend.pos[1],legend.pos[2],seps,fill=col,cex=cex.legend)
else legend(legend.pos,seps,fill=col,cex=cex.legend)
}
}
plotrix/R/dispersion.R 0000755 0001762 0000144 00000004362 14011145766 014473 0 ustar ligges users dispersion<-function(x,y,ulim,llim=ulim,intervals=TRUE,
arrow.cap=0.01,arrow.gap=NA,type="a",fill=NA,lty=NA,pch=NA,
border=NA,col=par("fg"),display.na=TRUE,...) {
if(is.list(x) && length(x[[1]]) == length(x[[2]])) {
y <- x$y
x <- x$x
}
if(missing(y) && !missing(x)) {
y <- x
x <- 1:length(x)
}
if(intervals) {
llim <- y - llim
ulim <- y + ulim
}
plotlim <- par("usr")
npoints <- length(x)
if(is.na(arrow.gap)) arrow.gap <- strheight("O")/1.5
if(length(col) < npoints) {
if(is.matrix(x) && length(col) == dim(x)[2])
col<-rep(col,each=dim(x)[1])
else col <- rep(col, npoints)
}
for(i in 1:npoints) {
if(toupper(type) == "A") {
if(!is.na(llim[i])) {
if(arrow.gap >= (y[i] - llim[i]) * 0.9) {
caplen <- arrow.cap * diff(par("usr")[1:2])
x0 <- x[i] - caplen
x1 <- x[i] + caplen
y0 <- y1 <- llim[i]
segments(x0, y0, x1, y1, col = col[i], ...)
}
else {
caplen <- arrow.cap * par("pin")[1]
x0 <- x1 <- x[i]
y0 <- y[i] - arrow.gap
y1 <- llim[i]
arrows(x0,y0,x1,y1,length=caplen,angle=90,col=col[i],...)
}
}
else {
if(display.na) {
x0 <- x1 <- x[i]
y0 <- y[i] - arrow.gap
y1 <- plotlim[3]
segments(x0, y0, x1, y1, col = col[i], ...)
}
}
if(!is.na(ulim[i])) {
if(arrow.gap >= (ulim[i] - y[i]) * 0.9) {
caplen <- arrow.cap * diff(par("usr")[1:2])
x0 <- x[i] - caplen
x1 <- x[i] + caplen
y0 <- y1 <- ulim[i]
segments(x0, y0, x1, y1, col = col[i], ...)
}
else {
caplen <- arrow.cap * par("pin")[1]
x0 <- x1 <- x[i]
y0 <- y[i] + arrow.gap
y1 <- ulim[i]
arrows(x0,y0,x1,y1,length=caplen,angle=90,col=col[i],...)
}
}
else {
if(display.na) {
x0 <- x1 <- x[i]
y0 <- y[i] + arrow.gap
y1 <- plotlim[4]
segments(x0, y0, x1, y1, col = col[i], ...)
}
}
}
}
if(toupper(type) == "L") {
if(!is.na(fill)) {
polygon(c(x,rev(x)),c(ulim,rev(llim)),col=fill,border = NA)
if(!is.na(pch)) {
if(is.na(lty)) points(x, y, pch = pch)
else lines(x, y, lty = lty, pch = pch, type = "b")
}
else {
if(!is.na(lty)) lines(x, y, lty = lty)
}
}
if(!is.na(border)) {
lines(x, ulim, lty = border, ...)
lines(x, llim, lty = border, ...)
}
}
}
plotrix/R/getFigCtr.R 0000755 0001762 0000144 00000000663 14011145766 014172 0 ustar ligges users getFigCtr<-function(pos=c(0.5,0.5)) {
pars<-par(c("usr","mar","fin","pin"))
pxspan<-diff(pars$usr[1:2])
fxspan<-pxspan*pars$fin[1]/pars$pin[1]
figxctr<-
pars$usr[1]-(fxspan-pxspan)*pars$mar[2]/(pars$mar[2]+pars$mar[4]) + fxspan*pos[1]
pyspan<-diff(pars$usr[3:4])
fyspan<-pyspan*pars$fin[2]/pars$pin[2]
figyctr<-
pars$usr[1]-(fyspan-pyspan)*pars$mar[1]/(pars$mar[1]+pars$mar[3]) + fyspan*pos[2]
return(c(figxctr,figyctr))
}
plotrix/R/addtable2plot.R 0000755 0001762 0000144 00000010040 14011145766 015023 0 ustar ligges users addtable2plot<-function(x,y=NULL,table,lwd=par("lwd"),bty="n",
bg=par("bg"),cex=1,xjust=0,yjust=1,xpad=0.1,ypad=0.5,box.col=par("fg"),
text.col=par("fg"),display.colnames=TRUE,display.rownames=FALSE,
hlines=FALSE,vlines=FALSE,title=NULL) {
# make sure that there is a graphics device open
if(dev.cur() == 1)
stop("Cannot add table unless a graphics device is open")
# check for an xy.coords structure
if(is.null(y)) {
if(is.character(x)) {
tablepos<-get.tablepos(x)
x<-tablepos$x
y<-tablepos$y
xjust<-tablepos$xjust
yjust<-tablepos$yjust
}
else {
if(is.null(x$y)) stop("both x and y coordinates must be given")
y<-x$y
x<-x$x
}
}
droptop<-ifelse(any(c("topleft","top","topright") %in% x),1,0)
tabdim<-dim(table)
if(tabdim[1] == 1) hlines<-FALSE
if(tabdim[2] == 1) vlines<-FALSE
# cat(tabdim,vlines,hlines,"\n")
if(is.null(dim(bg))) bg<-matrix(bg,nrow=tabdim[1],ncol=tabdim[2])
column.names<-colnames(table)
if(is.null(column.names) && display.colnames)
column.names<-1:tabdim[2]
row.names<-rownames(table)
if(is.null(row.names) && display.rownames)
row.names<-1:tabdim[1]
if(par("xlog")) x<-log10(x)
cellwidth<-rep(0,tabdim[2])
# assume that the column names will be at least as wide as the entries
if(display.colnames) {
for(column in 1:tabdim[2])
cellwidth[column]<-max(strwidth(c(column.names[column],
format(table[,column])),cex=cex))*(1+xpad)
nvcells<-tabdim[1]+1
}
else {
nvcells<-tabdim[1]
for(column in 1:tabdim[2])
cellwidth[column]<-max(strwidth(format(table[,column]),cex=cex))*(1+xpad)
}
if(display.rownames) {
nhcells<-tabdim[2]+1
rowname.width<-max(strwidth(row.names,cex=cex))*(1+xpad)
}
else {
nhcells<-tabdim[2]
rowname.width<-0
}
# cat(cellwidth,"\n")
if(par("ylog")) y<-log10(y)
cellheight<-
max(strheight(c(column.names,row.names,as.vector(unlist(table))),
cex=cex))*(1+ypad)
if(!is.null(title) & droptop) y<-y-cellheight
ytop<-y+yjust*nvcells*cellheight
# adjust for logarithmic plotting and allow the table to extend beyond the plot
oldpar<-par(xlog=FALSE,ylog=FALSE,xpd=TRUE)
if(display.colnames) {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
for(column in 1:tabdim[2]) {
text(xleft+cellwidth[column]*0.5,
ytop-0.5*cellheight,column.names[column],cex=cex,col=text.col)
xleft<-xleft+cellwidth[column]
}
}
for(row in 1:tabdim[1]) {
# start at the left edge of the table
xleft<-x-xjust*(sum(cellwidth)+rowname.width)
if(display.rownames) {
text(xleft+0.5*rowname.width,
ytop-(row+display.colnames-0.5)*cellheight,
row.names[row],cex=cex,col=text.col)
xleft<-xleft+rowname.width
}
for(column in 1:tabdim[2]) {
rect(xleft,ytop-(row+display.colnames-1)*cellheight,
xleft+cellwidth[column],ytop-(row+display.colnames)*cellheight,
col=bg[row,column],border=bg[row,column])
text(xleft+0.5*cellwidth[column],
ytop-(row+display.colnames-0.5)*cellheight,
table[row,column],cex=cex,col=text.col)
xleft<-xleft+cellwidth[column]
}
}
if(vlines) {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
segments(xleft+cumsum(cellwidth[-tabdim[2]]),
ytop-display.colnames*cellheight,
xleft+cumsum(cellwidth[-tabdim[2]]),
ytop-(display.colnames+tabdim[1])*cellheight)
}
if(hlines) {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
segments(xleft,
ytop-display.colnames*cellheight-cumsum(rep(cellheight,tabdim[1]-1)),
xleft+sum(cellwidth),
ytop-display.colnames*cellheight-cumsum(rep(cellheight,tabdim[1]-1)))
}
if(!is.null(title)) {
xleft<-x-xjust*(sum(cellwidth)+rowname.width)
text(xleft+(rowname.width+sum(cellwidth))/2,ytop+cellheight/2,title,
cex=cex,col=text.col)
}
if(bty == "o") {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
rect(xleft,ytop-(tabdim[1]+display.colnames)*cellheight,
xleft+sum(cellwidth),ytop-display.colnames*cellheight)
}
par(oldpar)
}
plotrix/R/panes.R 0000755 0001762 0000144 00000000436 14011145766 013420 0 ustar ligges users panes<-function(mat=NULL,widths=rep(1,ncol(mat)),heights=rep(1,nrow(mat)),
nrow=2,ncol=2,mar=c(0,0,1.6,0),oma=c(2.5,1,1,1)) {
oldpar<-par("mar","mfrow","oma")
if(is.null(mat)) par(mfrow=c(nrow,ncol),mar=mar,oma=oma)
else layout(mat,widths=widths,heights=heights)
return(oldpar)
}
plotrix/R/count.overplot.R 0000755 0001762 0000144 00000002607 14011145766 015315 0 ustar ligges users count.overplot<-function(x,y,tol=NULL,col=par("fg"),pch="1",...) {
if(missing(x)) stop("Usage: count.overplot(x,y,tol=NULL,...)")
dimx<-dim(x)
if(missing(y)) {
if(is.list(x) && names(x)[1] == "x") {
y<-x[[2]]
x<-x[[1]]
}
else {
if(!is.null(dimx)) {
y<-x[,2]
x<-x[,1]
}
}
}
if(any(is.na(x) | is.na(y))) {
indices<-!is.na(x) & !is.na(y)
x<-x[indices]
y<-y[indices]
}
xlim<-range(x)
ylim<-range(y)
xlen<-length(x)
if(xlen != length(y)) stop("x and y must be the same length.")
if(is.null(tol)) {
if(dev.cur() == 1 ) plot(x,y,type="n",axes=FALSE,xlab="",ylab="")
tol<-c(strwidth("o")/2,strheight("o")/2)
}
else {
if (length(tol) == 1) tol <- rep(tol,2)
}
if(length(col) < xlen) col<-rep(col,xlen)
if(length(pch) < xlen) pch<-rep(pch,xlen)
flags<-1:xlen
xsep<-ysep<-xdup<-ydup<-xydup<-sepcol<-seppch<-rep(0,xlen)
nsep<-ndup<-0
for(i in 1:xlen) {
if(!is.na(flags[i])) {
dups<-abs(x - x[i]) <= tol[1] & abs(y - y[i]) <= tol[2]
ndups<-sum(dups)
if(ndups > 1) {
ndup<-ndup + 1
xydup[ndup]<-ndups
xdup[ndup]<-x[i]
ydup[ndup]<-y[i]
}
else {
nsep<-nsep + 1
xsep[nsep]<-x[i]
ysep[nsep]<-y[i]
sepcol[nsep]<-col[i]
seppch[nsep]<-pch[i]
}
}
flags[dups]<-NA
}
plot(xsep[1:nsep],ysep[1:nsep],xlim=xlim,ylim=ylim,
col=sepcol[1:nsep],pch=seppch[1:nsep],...)
text(xdup[1:ndup],ydup[1:ndup],xydup[1:ndup],...)
}
plotrix/R/brkdnNest.R 0000755 0001762 0000144 00000007135 14011145766 014247 0 ustar ligges users jiggle<-function(n,range=c(-1,1)) return(rescale(sample(1:n,n),range))
valid.n<-function(x,na.rm=TRUE) return(if(na.rm) sum(!is.na(x)) else length(x))
propbrk<-function(x,trueval=TRUE,na.rm=TRUE) {
if(anyNA(x) || length(x) == 0) return(0)
else return(sum(x==trueval,na.rm=TRUE)/
(if(na.rm) valid.n(x) else length(x)))
}
sumbrk<-function(x,trueval=TRUE,na.rm=TRUE) {
return(sum(x==trueval,na.rm=TRUE))
}
binciW<-function(x,n,alpha=0.05,cc=FALSE) {
p<-x/n
q<-1-p
z<-qnorm(1-alpha/2)
z2<-z*z
if(cc) {
cil<-(2*n*p+z2-(z*sqrt(z2-1/n+4*n*p*q+(4*p-2))+1))/(2*(n+z2))
ciu<-(2*n*p+z2+(z*sqrt(z2-1/n+4*n*p*q+(4*p-2))+1))/(2*(n+z2))
} else {
cil<-(1/(1+z2/n))*(p+z2/(2*n)-z*sqrt((p/n*q)+z2/(4*n*n)))
ciu<-(1/(1+z2/n))*(p+z2/(2*n)+z*sqrt((p/n*q)+z2/(4*n*n)))
}
if(cil < 0) cil<-0
if(ciu > 1) ciu<-1
return(c(cil,ciu))
}
binciWu<-function(x,n,alpha=0.05,trueval=TRUE,na.rm=TRUE) {
if(missing(n)) n<-ifelse(na.rm,valid.n(x),length(x))
x<-sum(x==trueval,na.rm=TRUE)
return(binciW(x,n,alpha=alpha)[2])
}
binciWl<-function(x,n,alpha=0.05,trueval=TRUE,na.rm=TRUE) {
if(missing(n)) n<-ifelse(na.rm,valid.n(x),length(x))
x<-sum(x==trueval,na.rm=TRUE)
return(binciW(x,n,alpha=alpha)[1])
}
brkdnNest<-function(formula, data, FUN = c("mean", "sd", "sd", "valid.n"),
label1 = "Overall", trueval = TRUE) {
if(missing(data) || missing(formula)) stop("brkdnNest(formula,data,...")
bn<-as.character(attr(terms(formula), "variables")[-1])
nbn<-length(bn)
nFUN<-length(FUN)
brklist<-vector("list", nFUN)
truevalFUN<-c("propbrk","binciWu","binciWl","sumbrk")
brklevels<-list()
for(brk in 1:nbn)
if(is.factor(data[,bn[brk]])) brklevels[[brk]]<-levels(data[,bn[brk]])
else brklevels[[brk]]<-sort(unique(data[,bn[brk]]))
for(brkfun in 1:nFUN) {
brklist[[brkfun]] <- vector("list", nbn)
if(FUN[brkfun] %in% truevalFUN)
brklist[[brkfun]][[1]] <- do.call(FUN[brkfun], list(data[[bn[1]]],
trueval = trueval, na.rm = TRUE))
else brklist[[brkfun]][[1]] <- do.call(FUN[brkfun], list(data[[bn[1]]],
na.rm = TRUE))
names(brklist[[brkfun]][[1]]) <- label1
for(brk in 2:nbn) {
if(FUN[brkfun] %in% truevalFUN)
brklist[[brkfun]][[brk]] <- tapply(data[[bn[1]]],
data[bn[2:brk]], FUN = match.fun(FUN[brkfun]),
trueval = trueval)
else brklist[[brkfun]][[brk]] <- tapply(data[[bn[1]]],
data[bn[2:brk]], FUN = match.fun(FUN[brkfun]),
na.rm = TRUE)
names(brklist[[brkfun]][[brk]]) <- brklevels[[brk]]
}
if(FUN[brkfun] == "valid.n")
brklist[[brkfun]]<-
rapply(brklist[[brkfun]],function(x) ifelse(is.na(x),0,x),how="replace")
}
if(trueval == "prop") {
brklist[[1]][[2]]<-brklist[[1]][[2]]/brklist[[1]][[1]]
for(column in 1:ncol(brklist[[1]][[3]])) {
brklist[[1]][[3]][,column]<-
brklist[[1]][[3]][,column]/sum(brklist[[1]][[3]][,column])
}
brklist[[1]][[1]]<-1
}
attr(brklist, "class") <- "brklist"
names(brklist) <- FUN
return(brklist)
}
sliceArray<-function(x,slice) {
dimx<-dim(x)
if(is.null(dimx)) return(x[slice])
else {
ndim<-length(dimx)
slicestring<-
paste("x[",slice,paste(rep(",",ndim-1),collapse=""),"]",sep="",collapse="")
newx<-eval(parse(text=slicestring))
return(newx)
}
}
print.brklist<-function(x,...) {
crawlBreakList<-function(x,depth=1) {
if(length(x)>1) {
if(depth==1) cat(names(x[[1]]),unlist(x[[1]]),"\n")
x[[1]]<-NULL
for(nextbit in 1:length(x[[1]])) {
newx<-lapply(x,sliceArray,nextbit)
cat(rep("\t",depth),names(x[[1]][nextbit]),unlist(x[[1]][nextbit]),"\n")
crawlBreakList(newx,depth=depth+1)
}
}
}
xnames<-names(x)
for(func in 1:length(x)) {
cat(xnames[func],"\n")
crawlBreakList(x[[func]])
}
}
plotrix/R/starPie.R 0000644 0001762 0000144 00000003130 14011145766 013710 0 ustar ligges users starPie<-function(x,y,radext,values,maxval=NA,border=par("fg"),col=NA,
prop.area=FALSE,label="",labelpos=1) {
valdim<-dim(values)
if(is.null(valdim)) {
npies<-1
values<-matrix(values,nrow=1)
valdim<-dim(values)
}
nfaces<-valdim[2]
if(is.na(x[1])) x<-rep(1:valdim[1],valdim[2])
if(is.na(y[1])) y<-rep(1:valdim[2],each=valdim[1])
if(length(labelpos) < valdim[1])
labelpos<-rep(labelpos,length.out=valdim[1]*valdim[2])
if(is.na(col[1])) col<-rainbow(nfaces)
if(length(col) 1) totals<-heights[,2]
heights<-as.vector(heights)
}
if(!is.numeric(heights))
stop("heights must be a numeric vector or matrix/data frame with numeric first column")
nbars<-length(heights)
if(length(prefix) < nbars) prefix<-rep(prefix,length.out=nbars)
if(length(suffix) < nbars) suffix<-rep(suffix,length.out=nbars)
# if no marker for increments (FALSE | 0) and totals (TRUE | non-zero)
# consider the first and last values to be totals and all others increments
if(is.na(totals[1])) totals<-c(TRUE,rep(FALSE,nbars-2),TRUE)
# coerce totals to a logical vector if it isn't
if(!is.logical(totals)) totals<-totals != 0
oldmar<-par("mar")
if(!is.na(bg.col)) {
oldbg<-par("bg")
par(bg=bg.col)
}
maxht<-max(heights)
# if there is a negative total height, make that the minimum, otherwise zero
minht<-min(c(min(heights[totals]),0))
currht<-heights[1]
for(i in 2:nbars) {
if(!totals[i]) {
currht<-currht+heights[i]
if(currht > maxht) maxht<-currht
}
}
if(direction == "e" || direction == "w") {
if(is.na(mar[1])) mar<-c(10,2,3,2)
par(mar=mar,xaxs="i")
plot(0,xlim=c(0.5,nbars+0.5),ylim=c(minht,maxht),type="n",axes=FALSE,
xlab="",ylab="",...)
}
else {
if(is.na(mar[1])) mar<-c(2,10,3,2)
par(mar=mar,yaxs="i")
plot(0,xlim=c(minht,maxht),ylim=c(0.5,nbars+0.5),type="n",axes=FALSE,
xlab="",ylab="",...)
}
par(xpd=TRUE)
bar.col<-rep(NA,nbars)
if(length(stair.info$inc.col) < sum(!totals))
stair.info$inc.col=rep(stair.info$inc.col,length.out=sum(!totals))
bar.col[!totals]<-stair.info$inc.col
bar.col[totals]<-stair.info$total.col
label_offset<-ifelse(direction == "e" || direction == "w",
strheight("M"),strwidth("M"))
if(direction == "s" || direction == "w") {
start<-nbars
finish<-1
dir<- -1
}
else {
start<-1
finish<-nbars
dir<-1
}
barend<-0
barpos<-start:finish
for(bar in 1:nbars) {
barstart<-ifelse(totals[bar],0,barend)
barend<-barstart+heights[bar]
if(direction == "e" || direction == "w") {
rect(barpos[bar]-halfwidth,barstart,barpos[bar]+halfwidth,barend,
col=bar.col[bar],border=stair.info$border)
if(display.height)
text(barpos[bar],ifelse(heights[bar]<0,barstart,barend)+label_offset,
paste(prefix[bar],heights[bar],suffix[bar],sep=""),cex=cex)
if(direction == "e" && bar != nbars)
segments(barpos[bar]+halfwidth*dir,barend,barpos[bar]+dir-halfwidth*dir,
barend,lty=3)
if(direction == "w" && bar != nbars)
segments(barpos[bar]-halfwidth*dir,barend,barpos[bar]+dir+halfwidth*dir,
barend,lty=3)
if(!is.null(labels)) {
labelline<-0.2
if(stagger) labelline<-c(labelline,1.2)
mtext(labels,side=1,line=labelline,at=start:finish,adj=0.5,padj=1,
las=las,cex=cex)
}
}
else {
rect(barstart,barpos[bar]-halfwidth,barend,barpos[bar]+halfwidth,
col=bar.col[bar])
if(display.height)
text(ifelse(heights[bar]<0,barstart,barend)+label_offset,
barpos[bar],paste(prefix[bar],heights[bar],suffix[bar],sep=""),adj=0,cex=cex)
if(bar != nbars)
segments(barend,barpos[bar]+halfwidth*dir,barend,
barpos[bar]+dir-halfwidth*dir,lty=3)
if(!is.null(labels)) {
labelline<-0.5
if(stagger) labelline<-c(labelline,1.5)
mtext(labels,side=2,line=labelline,at=start:finish,adj=1,las=las,cex=cex)
}
}
}
if(nchar(main)) mtext(main,line=mar[3]/2,at=getFigCtr()[1],cex=1.5)
par(xpd=FALSE,mar=oldmar)
if(!is.na(bg.col)) par(bg=oldbg)
}
plotrix/R/raw.means.plot.R 0000744 0001762 0000144 00000020305 14011145766 015155 0 ustar ligges users
# more explanatory name for the function
raw.means.plot <-function(data, col.offset = 2, col.x = 3, col.value = 4, na.rm = FALSE,
avoid.overlap = c("y", "x", "both"), y.factor = 1, y.amount = NULL, x.amount = 0.05,
pch = 21:25, lty = 1:5, bg.b.col = "darkgrey",
bg.f.col = NULL, fg.b.col = "black", fg.f.col = "black",
type = "o", pt.cex = 1, lwd = 1, xlab = "", ylab = "", ylim,
max.offset = 0.2, xaxis = TRUE, x.labels, xaxt = "n", plot = TRUE,
legend = TRUE, mar = NULL, reset.mar = TRUE, l.pos, yjust = 0.5,
l.bty = "n", l.adj = c(0, 0.5), ...)
{
# I somehow like more the idea of using random jitter.
spread.out <- function(x, x.amount) {
dupl <- duplicated(x)
spreadx <- rep(0,length(x))
spreadx[dupl] <- jitter(spreadx[dupl], amount = x.amount)
return(spreadx)
}
addJitter <- function (x, y.factor, y.amount) {
dupl <- duplicated(x)
x[dupl] <- jitter(x[dupl], factor = y.factor, amount = y.amount)
return(x)
}
# I personally more like the spreading on the y-axis, but I totally agree that
# spacing on the x-axis is also totally reasonable.
create.dp <- function(lst, n.x, avoid.overlap, y.factor, y.amount, x.amount) {
ret <- vector("list", 2)
#browser()
if (avoid.overlap[1] %in% c("x", "both"))
ret[[1]] <- rep(1:n.x, vapply(lst, length, 0)) +
unlist(lapply(lst, spread.out, x.amount = x.amount))
else ret[[1]] <- rep(1:n.x, vapply(lst, length, 0))
if (avoid.overlap[1] %in% c("y", "both"))
ret[[2]] <- unlist(lapply(lst, addJitter, y.factor=y.factor, y.amount = y.amount))
else ret[[2]] <- unlist(lst)
return(ret)
}
largs <- c("fill", "border", "angle", "density", "box.lwd",
"box.lty", "box.col", "pt.lwd", "xjust", "x.intersp",
"y.intersp", "text.width", "text.col", "merge", "trace",
"plot", "ncol", "horiz", "title", "inset", "title.col",
"title.adj")
dots <- list(...)
args.to.l <- dots[names(dots) %in% largs]
args.to.p <- dots[!(names(dots) %in% largs)]
if (!is.data.frame(data))
stop("data must be a data.frame")
# I used "any" here as it seems more straightforward
# I notice that you used it in add.ps
if (any(is.na(data[, c(col.offset, col.x)])))
warning("NAs in offset or x column (this produces other warnings).")
# as above
if (na.rm == FALSE)
if (any(is.na(data[, c(col.value)])))
stop("NAs in data column. Try: na.rm = TRUE")
if (!is.factor(data[, col.offset])) {
warning(paste("Converting offset variable (column ",
col.offset, ") to factor.", sep = ""))
data[, col.offset] <- factor(data[, col.offset])
}
if (!is.factor(data[, col.x])) {
warning(paste("Converting x-axis variable (column ",
col.offset, ") to factor.", sep = ""))
data[, col.x] <- factor(data[, col.x])
}
if ((length(levels(data[, col.x])) != length(unique(data[, col.x])))) {
warning(paste("Refactoring x-axis variable (column ",
col.x, ") due to length mismatch.", sep = ""))
data[, col.x] <- factor(data[, col.x])
}
if ((length(levels(data[, col.offset])) != length(unique(data[,
col.offset])))) {
warning(paste("Refactoring offset variable (column ",
col.offset, ") due to length mismatch.", sep = ""))
data[, col.offset] <- factor(data[, col.offset])
}
if (missing(ylim)) {
# I think that range is equivalent to c(min,max) here
ylim <- range(data[, col.value], na.rm = na.rm)
warning(paste("ylim not specified, taken from data: ",
ylim[1], " - ", ylim[2], sep = ""))
}
n.offset <- length(levels(data[, col.offset]))
n.x <- length(levels(data[, col.x]))
if (!(missing(x.labels))) {
if (length(x.labels) < n.x) {
warning("x.labels too short, taking unique(data[,col.x]) as labels at x-axis ticks")
x.labels <- levels(data[, col.x])
}
}
while (length(pch) < n.offset) {
warning("pch vector too short. recycling pch vector.")
# this makes sure that the pch vector will be long enough
pch <- rep(pch, length.out=n.offset)
}
while (length(lty) < n.offset) {
warning("lty vector too short. recycling lty vector.")
# ditto for the line type
lty <- rep(lty, length.out=n.offset)
}
if (!is.null(bg.b.col)) {
while (length(bg.b.col) < n.offset) {
bg.b.col <- rep(bg.b.col, length.out=n.offset)
}
}
if (!is.null(bg.f.col)) {
while (length(bg.f.col) < n.offset) {
bg.f.col <- rep(bg.f.col, length.out=n.offset)
}
}
if (!is.null(fg.b.col)) {
while (length(fg.b.col) < n.offset) {
fg.b.col <- rep(fg.b.col, length.out=n.offset)
}
}
if (!is.null(fg.f.col)) {
while (length(fg.f.col) < n.offset) {
fg.f.col <- rep(fg.f.col, length.out=n.offset)
}
}
if (missing(x.labels)) {
x.labels <- levels(data[, col.x])
}
orig.mar <- par("mar")
if (legend == TRUE & is.null(mar)) {
mar <- orig.mar
max.l <- max(nchar(levels(data[, col.offset])))
if (max.l < 3)
rb <- 4.2
else if (max.l > 2 & max.l < 5)
rb <- 5
else if (max.l > 4 & max.l < 7)
rb <- 6
else if (max.l > 6 & max.l < 9)
rb <- 7
else rb <- 8
mar[4] <- rb + 0.1
}
if (!plot)
mar <- c(0, 0, 0, 0)
if (!is.null(mar))
res.mar <- par(mar = mar)
nd <- split(data, data[, col.offset])
if (plot) {
do.call("plot", c(list(x = 1, y = 2, xlim = c((1 - max.offset -
0.2), (n.x + max.offset + 0.2)), ylim = ylim, xaxt = xaxt,
type = "n", xlab = xlab, ylab = ylab), args.to.p))
if (n.offset > 1) {
offset.start <- max.offset - ((1 - (n.offset%%2)) *
(max.offset/n.offset))
offset.dist <- max.offset/((n.offset - (n.offset%%2))/2)
}
if (n.offset == 1) {
offset.start <- 0
offset.dist <- 0
}
for (c in 1:n.offset) {
d.c <- nd[[c]]
d.lst <- split(d.c[, col.value], d.c[, col.x])
dp <- create.dp(lst = d.lst, n.x = n.x, avoid.overlap = avoid.overlap, y.factor = y.factor, y.amount = y.amount, x.amount = x.amount)
x <- dp[[1]] - ((offset.start) - ((c - 1) * offset.dist))
y <- dp[[2]]
points(x, y, pch = pch[c], col = bg.b.col[c], bg = bg.f.col[c],
cex = pt.cex)
}
for (c in 1:n.offset) {
d.c <- nd[[c]]
d.lst <- split(d.c[, col.value], d.c[, col.x])
x <- 1:n.x - ((offset.start) - ((c - 1) * offset.dist))
y <- vapply(d.lst, mean, 0, na.rm = na.rm)
lines(x, y, pch = pch[c], type = type, lty = lty[c],
col = fg.b.col[c], bg = fg.f.col[c], cex = pt.cex,
lwd = lwd)
}
if (xaxis == TRUE)
axis(side = 1, at = 1:n.x, labels = x.labels)
}
if (!plot) {
plot(0, 0, type = "n", xlim = c(0, 10), ylim = c(0, 10),
axes = FALSE, ylab = "", xlab = "", mar = c(0, 0,
0, 0))
if (missing(l.pos))
l.pos = c(5, 5)
}
if (legend == TRUE) {
if (n.x == 1) {
if (missing(l.pos)) {
l.pos <- (n.x + 0.45)
l.pos[2] <- (ylim[2] - ((ylim[2] - ylim[1])/2))
}
lty <- NULL
}
else (if (missing(l.pos)) {
l.pos <- (n.x + max.offset + 0.4)
l.pos[2] <- (ylim[2] - ((ylim[2] - ylim[1])/2))
})
do.call("legend", c(list(x = l.pos[1], y = l.pos[2],
levels(data[, col.offset]), pch = pch, lty = lty, col = fg.b.col,
pt.bg = fg.f.col, yjust = yjust, bty = l.bty, adj = l.adj,
xpd = TRUE, pt.cex = pt.cex, lwd = lwd), args.to.l))
}
if (legend == TRUE & reset.mar == TRUE) {
par(mar = res.mar)
}
}
plotrix/R/symbolbarplot.R 0000755 0001762 0000144 00000006237 14011145766 015210 0 ustar ligges users symbolbarplot<-function(height,width=1,space=NULL,names.arg=NULL,
legend.text=NULL,beside=FALSE,horiz=FALSE,col=heat.colors(NR),
border=par("fg"),main=NULL,sub=NULL,xlab=NULL,ylab=NULL,
xlim=NULL,ylim=NULL,axes=TRUE,axisnames=TRUE,inside=TRUE,
plot=TRUE,rel.width=0.8,symbol="circles",symbbox=TRUE,debug=FALSE,...) {
if(!missing(inside)) .NotYetUsed("inside", error = FALSE)
if(!missing(border)) .NotYetUsed("border", error = FALSE)
if(missing(space))
space<-if(is.matrix(height) && beside) c(0, 1) else 0.2
space<-space*mean(width)
if(plot && axisnames && missing(names.arg))
names.arg<-if (is.matrix(height)) colnames(height) else names(height)
if(is.vector(height)) {
height <- cbind(height)
beside <- TRUE
}
else {
if(is.array(height) && (length(dim(height)) == 1)) {
height <- rbind(height)
beside <- TRUE
}
else if(!is.matrix(height)) stop("`height' must be a vector or a matrix")
}
NR <- nrow(height)
NC <- ncol(height)
if(beside) {
if(length(space) == 2)
space <- rep(c(space[2],rep(space[1],NR - 1)),NC)
width <- rep(width,length = NR * NC)
}
else {
width <- rep(width,length = NC)
height <- rbind(0,apply(height,2,cumsum))
}
delta <- width/2
w.r <- cumsum(space + width)
w.m <- w.r - delta
w.l <- w.m - delta
if(horiz) {
if(missing(xlim)) xlim <- range(-0.01 * height, height)
if(missing(ylim)) ylim <- c(min(w.l), max(w.r))
}
else {
if(missing(xlim)) xlim <- c(min(w.l), max(w.r))
if(missing(ylim)) ylim <- range(-0.01 * height, height)
}
if(beside) w.m <- matrix(w.m, ncol = NC)
if(plot) {
opar<-
if (horiz) par(xaxs = "i", xpd = TRUE)
else par(yaxs = "i", xpd = TRUE)
on.exit(par(opar))
plot.new()
plot.window(xlim, ylim, log = "", ...)
xyrect<-function(x1,y1,x2,y2,horizontal = TRUE,n,col,...) {
if(horizontal)
multsymbolbox(x1, y1, x2, y2, tot = x2 - x1,
bg = col, fg = col, relw = rel.width, box = symbbox,
debug = debug, ...)
else
multsymbolbox(y1, x1, y2, x2, tot = x2 - x1,
bg = col, fg = col, relw = rel.width, box = symbbox,
debug = debug, ...)
}
if(beside) xyrect(0,w.l,c(height),w.r,horizontal=horiz,col=col,n=c(height))
else {
for (i in 1:NC) {
xyrect(height[1:NR, i], w.l[i], height[-1, i],
w.r[i], horizontal = horiz, col = col, n = height[1:NR,i])
}
}
if(axisnames && !is.null(names.arg)) {
at.l<-
if(length(names.arg) != length(w.m)) {
if(length(names.arg) == NC) apply(w.m, 2, mean)
else stop("incorrect number of names")
}
else w.m
axis(if(horiz) 2 else 1,at=at.l,labels=names.arg,lty = 0)
}
if(!is.null(legend.text)) {
legend.col <- rep(col, length = length(legend.text))
if ((horiz & beside) || (!horiz & !beside)) {
legend.text <- rev(legend.text)
legend.col <- rev(legend.col)
}
xy<-par("usr")
legend(xy[2] - xinch(0.1), xy[4] - yinch(0.1), legend = legend.text,
fill = legend.col, xjust = 1, yjust = 1)
}
title(main = main,sub = sub,xlab = xlab,ylab = ylab,...)
if(axes) axis(if(horiz) 1 else 2)
invisible(w.m)
}
else w.m
}
plotrix/R/getIntersectList.R 0000755 0001762 0000144 00000002004 14011145766 015577 0 ustar ligges users getIntersectList<-function(nelem,xnames=NULL,sep="+") {
if(is.null(xnames)) xnames<-LETTERS[1:nelem]
xnamelen<-length(xnames)
if(xnamelen < nelem) {
extranames<-paste("extra",1:(nelem-xnamelen),sep=sep)
cat("Not enough names in",xnames,"adding",extranames,"\n")
xnames<-c(xnames,extranames)
}
intersectList<-vector("list",nelem+2)
total_n<-0
for(comb in 1:nelem) {
nn<-choose(nelem,comb)
intersectList[[comb]]<-rep(0,nn)
currentnames<-names(intersectList[[comb]])<-
pasteCols(combn(xnames,comb),sep=sep)
for(intersect in 1:nn) {
cat("Number of elements in",currentnames[intersect],"- ")
current_n<-scan(nmax=1,quiet=TRUE)
intersectList[[comb]][intersect]<-current_n
total_n<-total_n+current_n
}
}
cat("Total number of elements (press Enter for ",total_n,") - ",
sep="")
intersectList[[nelem + 1]]<-scan(nmax=1,quiet=TRUE)
if(length(intersectList[[nelem+1]])==0)
intersectList[[nelem+1]]<-total_n
intersectList[[nelem+2]]<-xnames
class(intersectList) <- "intersectList"
return(intersectList)
}
plotrix/R/pyramid.plot.R 0000755 0001762 0000144 00000011746 14011145766 014742 0 ustar ligges users pyramid.plot<-function (lx, rx, labels = NA, top.labels = c("Male", "Age",
"Female"), main = "", laxlab = NULL, raxlab = NULL, unit = "%",
lxcol, rxcol, gap = 1, space = 0.2, ppmar = c(4, 2, 4, 2),
labelcex = 1, add = FALSE, xlim, show.values = FALSE, ndig = 1,
do.first = NULL) {
if (any(c(lx, rx) < 0, na.rm = TRUE))
stop("Negative quantities not allowed")
lxdim <- dim(lx)
rxdim <- dim(rx)
ncats <- ifelse(!is.null(lxdim), dim(lx)[1], length(lx))
if (length(labels) == 1)
labels <- 1:ncats
ldim <- length(dim(labels))
nlabels <- ifelse(ldim, length(labels[, 1]), length(labels))
if (nlabels != ncats)
stop("lx and labels must all be the same length")
if (missing(xlim))
xlim <- rep(ifelse(!is.null(lxdim), ceiling(max(c(rowSums(lx),
rowSums(rx)), na.rm = TRUE)), ceiling(max(c(lx, rx),
na.rm = TRUE))), 2)
if (!is.null(laxlab) && xlim[1] < max(laxlab))
xlim[1] <- max(laxlab)
if (!is.null(raxlab) && xlim[2] < max(raxlab))
xlim[2] <- max(raxlab)
oldmar <- par("mar")
if (!add) {
par(mar = ppmar, cex.axis = labelcex)
plot(0, xlim = c(-(xlim[1] + gap), xlim[2] + gap), ylim = c(0,
ncats + 1), type = "n", axes = FALSE, xlab = "",
ylab = "", xaxs = "i", yaxs = "i", main = main)
if (!is.null(do.first))
eval(parse(text = do.first))
if (is.null(laxlab)) {
laxlab <- seq(xlim[1] - gap, 0, by = -1)
axis(1, at = -xlim[1]:-gap, labels = laxlab)
}
else axis(1, at = -(laxlab + gap), labels = laxlab)
if (is.null(raxlab)) {
raxlab <- 0:(xlim[2] - gap)
axis(1, at = gap:xlim[2], labels = raxlab)
}
else axis(1, at = raxlab + gap, labels = raxlab)
if (gap > 0) {
if (!is.null(lxdim))
axis(2, at = 1:ncats, labels = rep("", ncats),
pos = gap, tcl = -0.25)
else axis(2, at = 1:ncats * as.logical(rx + 1), labels = rep("",
ncats), pos = gap, tcl = -0.25)
if (!is.null(lxdim))
axis(4, at = 1:ncats, labels = rep("", ncats),
pos = -gap, tcl = -0.25)
else axis(4, at = 1:ncats * as.logical(lx + 1), labels = rep("",
ncats), pos = -gap, tcl = -0.25)
}
if (is.null(dim(labels))) {
if (gap)
text(0, 1:ncats, labels, cex = labelcex)
else {
text(xlim[1], 1:ncats, labels, cex = labelcex,
adj = 0)
text(xlim[2], 1:ncats, labels, cex = labelcex,
adj = 1)
}
}
else {
if (gap) {
lpos <- -gap
rpos <- gap
}
else {
lpos <- -xlim[1]
rpos <- xlim[2]
}
text(lpos, 1:ncats, labels[, 1], pos = 4, cex = labelcex,
adj = 0)
text(rpos, 1:ncats, labels[, 2], pos = 2, cex = labelcex,
adj = 1)
}
cat(xlim,"\n")
mtext(top.labels,side=3,line=0,
at=c(-(xlim[1]+gap)/2,0,(xlim[2]+gap)/2),
adj = 0.5, cex = labelcex)
if(length(unit) == 1) mtext(unit,1,2.5,at=0,cex=labelcex)
else
mtext(c(unit,unit),1,2.5,at=c(-(xlim[1]+gap)/2,(xlim[2]+gap)/2),
cex=labelcex)
}
halfwidth <- 0.5 - space/2
if (is.null(lxdim)) {
if (missing(lxcol))
lxcol <- rainbow(ncats)
if (missing(rxcol))
rxcol <- rainbow(ncats)
rect(-(lx + gap), 1:ncats - halfwidth, rep(-gap, ncats),
1:ncats + halfwidth, col = lxcol)
rect(rep(gap, ncats), 1:ncats - halfwidth, (rx + gap),
1:ncats + halfwidth, col = rxcol)
if (show.values) {
par(xpd = TRUE)
lxt <- formatC(lx, format = "f", digits = ndig)
rxt <- formatC(rx, format = "f", digits = ndig)
text(-(gap + lx), 1:ncats, lxt, pos = 2, cex = labelcex)
text(gap + rx, 1:ncats, rxt, pos = 4, cex = labelcex)
par(xpd = FALSE)
}
}
else {
nstack <- dim(lx)[2]
if (missing(lxcol))
lxcol <- rainbow(nstack)
if (missing(rxcol))
rxcol <- rainbow(nstack)
lxstart <- rxstart <- rep(gap, ncats)
for (i in 1:nstack) {
lxcolor <- rep(lxcol[i], ncats)
rxcolor <- rep(rxcol[i], ncats)
rect(-(lx[, i] + lxstart), 1:ncats - halfwidth, -lxstart,
1:ncats + halfwidth, col = lxcolor)
rect(rxstart, 1:ncats - halfwidth, rx[, i] + rxstart,
1:ncats + halfwidth, col = rxcolor)
lxstart <- lx[, i] + lxstart
rxstart <- rx[, i] + rxstart
}
}
return(oldmar)
}
plotrix/R/get.tablepos.R 0000644 0001762 0000144 00000002434 14011145766 014676 0 ustar ligges users get.tablepos<-function(x) {
plotlim<-par("usr")
tablepos<-list()
if(x == "bottomleft") {
tablepos$x<-plotlim[1]
tablepos$y<-plotlim[3]
tablepos$xjust<-0
tablepos$yjust<-1
}
if(x == "bottom") {
tablepos$x<-(plotlim[2]+plotlim[1])/2
tablepos$y<-plotlim[3]
tablepos$xjust<-0.5
tablepos$yjust<-1
}
if(x == "bottomright") {
tablepos$x<-plotlim[2]
tablepos$y<-plotlim[3]
tablepos$xjust<-1
tablepos$yjust<-1
}
if(x == "left") {
tablepos$x<-plotlim[1]
tablepos$y<-(plotlim[3]+plotlim[4])/2
tablepos$xjust<-0
tablepos$yjust<-0.5
}
if(x == "right") {
tablepos$x<-plotlim[2]
tablepos$y<-(plotlim[3]+plotlim[4])/2
tablepos$xjust<-1
tablepos$yjust<-0.5
}
if(x == "topleft") {
tablepos$x<-plotlim[1]
tablepos$y<-plotlim[4]
tablepos$xjust<-0
tablepos$yjust<-0
}
if(x == "top") {
tablepos$x<-(plotlim[2]+plotlim[1])/2
tablepos$y<-plotlim[4]
tablepos$xjust<-0.5
tablepos$yjust<-0
}
if(x == "topright") {
tablepos$x<-plotlim[2]
tablepos$y<-plotlim[4]
tablepos$xjust<-1
tablepos$yjust<-0
}
# if no recognizable position was passed, put it in the center
if(x == "center" || length(tablepos)==0) {
tablepos$x<-(plotlim[1]+plotlim[2])/2
tablepos$y<-(plotlim[3]+plotlim[4])/2
tablepos$xjust<-0.5
tablepos$yjust<-0.5
}
return(tablepos)
}
plotrix/R/color.scale.R 0000755 0001762 0000144 00000005443 14011145766 014521 0 ustar ligges users color.scale<-function(x,cs1=c(0,1),cs2=c(0,1),cs3=c(0,1),alpha=1,
extremes=NA,na.color=NA,xrange=NULL,color.spec="rgb") {
xdim<-dim(x)
if (diff(range(x, na.rm = TRUE)) == 0) x<-x/max(x,na.rm=TRUE)
naxs<-is.na(x)
if(!is.na(extremes[1])){
# calculate the color ranges from the extremes - only for rgb
colmat<-col2rgb(extremes)
cs1<-colmat[1,]/255
cs2<-colmat[2,]/255
cs3<-colmat[3,]/255
color_spec<-"rgb"
}
maxcs1<-ifelse(color.spec=="hcl",360,1)
maxcs2<-ifelse(color.spec=="hcl",100,1)
maxcs3<-ifelse(color.spec=="hcl",100,1)
maxalpha<-1
ncolors<-length(x)
if(is.null(xrange)) {
xrange<-range(x,na.rm=TRUE)
drop.extremes<-FALSE
}
else {
if(xrange[1] > min(x,na.rm=TRUE) || xrange[2] < max(x,na.rm=TRUE))
stop("An explicit range for x must include the range of x values.")
x<-c(xrange,x)
drop.extremes=TRUE
}
ncs1<-length(cs1)
if(ncs1>1) {
cs1s<-rep(cs1[ncs1],ncolors)
xstart<-xrange[1]
xinc<-diff(xrange)/(ncs1-1)
for(seg in 1:(ncs1-1)){
segindex<-which((x >= xstart) & (x <= (xstart+xinc)))
cs1s[segindex]<-rescale(x[segindex],cs1[c(seg,seg+1)])
xstart<-xstart+xinc
}
if(min(cs1s,na.rm=TRUE) < 0 || max(cs1s,na.rm=TRUE) > maxcs1)
cs1s<-rescale(cs1s,c(0,maxcs1))
}
else cs1s<-rep(cs1,ncolors)
ncs2<-length(cs2)
if(ncs2>1) {
cs2s<-rep(cs2[ncs2],ncolors)
xstart<-xrange[1]
xinc<-diff(xrange)/(ncs2-1)
for(seg in 1:(ncs2-1)){
segindex<-which((x >= xstart) & (x <= (xstart+xinc)))
cs2s[segindex]<-rescale(x[segindex],cs2[c(seg,seg+1)])
xstart<-xstart+xinc
}
if(min(cs2s,na.rm=TRUE) < 0 || max(cs2s,na.rm=TRUE) > maxcs2)
cs2s<-rescale(cs2s,c(0,maxcs2))
}
else cs2s<-rep(cs2,ncolors)
ncs3<-length(cs3)
if(ncs3>1) {
cs3s<-rep(cs3[ncs3],ncolors)
xstart<-xrange[1]
xinc<-diff(xrange)/(ncs3-1)
for(seg in 1:(ncs3-1)){
segindex<-which((x >= xstart) & (x <= (xstart+xinc)))
cs3s[segindex]<-rescale(x[segindex],cs3[c(seg,seg+1)])
xstart<-xstart+xinc
}
if(min(cs3s,na.rm=TRUE) < 0 || max(cs3s,na.rm=TRUE) > maxcs3)
cs3s<-rescale(cs3s,c(0,maxcs3))
}
else cs3s<-rep(cs3,ncolors)
nalpha<-length(alpha)
if(nalpha>1) {
alphas<-rep(alpha[nalpha],ncolors)
xstart<-xrange[1]
xinc<-diff(xrange)/(nalpha-1)
for(seg in 1:(nalpha-1)){
segindex<-which((x >= xstart) & (x <= (xstart+xinc)))
alphas[segindex]<-rescale(x[segindex],alpha[c(seg,seg+1)])
xstart<-xstart+xinc
}
if(min(alphas,na.rm=TRUE) < 0 || max(alphas,na.rm=TRUE) > maxalpha)
alphas<-rescale(alphas,c(0,maxalpha))
}
else alphas<-rep(alpha,ncolors)
if(drop.extremes) {
# drop the first two (extreme) values in each vector
cs1s<-cs1s[-(1:2)]
cs2s<-cs2s[-(1:2)]
cs3s<-cs3s[-(1:2)]
}
colors<-do.call(color.spec,list(cs1s,cs2s,cs3s,alphas))
if(!is.null(xdim)) colors<-matrix(colors,nrow=xdim[1])
if(length(naxs)) colors[naxs]<-na.color
return(colors)
}
plotrix/R/radial.plot.labels.R 0000755 0001762 0000144 00000002361 14011145766 015763 0 ustar ligges users radial.plot.labels<-function(lengths,radial.pos=NULL,units="radians",
radial.lim = NULL,start=0,clockwise=FALSE,labels,adj=NULL,pos=NULL,
boxed.labels=FALSE,...) {
npoints<-length(lengths)
if(is.null(radial.pos))
radial.pos<-seq(0,pi*(2-2/npoints),length.out=npoints)
else {
# clock24 starts at "midnight" and always runs clockwise
if(units == "clock24") {
if(is.character(radial.pos)) {
splittime<-strsplit(radial.pos,":")
hm2dh<-function(x) return(as.numeric(x[1])+as.numeric(x[2])/60)
radial.pos<-sapply(splittime,hm2dh)
}
radial.pos<-pi*(450-radial.pos*15)/180
start<-pi*(450-start*15)/180
}
# polar starts at 3 o'clock and runs counterclockwise by default
if(units == "polar") {
radial.pos <- pi * radial.pos/180
start <- pi * start/180
}
}
if(clockwise && units != "clock24") radial.pos<--radial.pos
if (start && units != "clock24") radial.pos<-radial.pos+start
if (is.null(radial.lim)) radial.lim <- range(lengths)
lengths<-lengths-radial.lim[1]
# get the vector of x positions
xpos<-cos(radial.pos)*lengths
# get the vector of y positions
ypos<-sin(radial.pos)*lengths
if(boxed.labels)
boxed.labels(x=xpos,y=ypos,labels=labels,...)
else text(x=xpos,y=ypos,labels=labels,adj=adj,pos=pos,...)
}
plotrix/R/twoord.plot.R 0000755 0001762 0000144 00000010515 14011145766 014604 0 ustar ligges users color.axis<-function(side=1,at=NULL,labels=TRUE,axlab=NA,axlab.at=NA,
col=par("fg"),cex.axis=par("cex.axis"),cex=par("cex")) {
xylim<-par("usr")
if(side %% 2) {
at.ok<-at >= xylim[1] & at <= xylim[2]
if(sum(at.ok) < length(at)) {
at<-at[at.ok]
labels<-labels[at.ok]
}
}
else {
at.ok<-at >= xylim[3] & at <= xylim[4]
if(sum(at.ok) < length(at)) {
at<-at[at.ok]
labels<-labels[at.ok]
}
}
axis(side=side,at=at,labels=rep("",length(at)),col=col)
if(labels[1] == TRUE && length(labels) == 1) labels<-at
mtext(labels,side=side,at=at,line=0.7,col=col,cex=cex.axis)
if(!is.na(axlab)) {
if(is.na(axlab.at))
axlab.at<-ifelse(side%%2,sum(xylim[1:2])/2,sum(xylim[3:4])/2)
mtext(axlab,side=side,at=axlab.at,line=2,col=col,cex=cex)
}
if(side == 1) abline(h=xylim[3],col=col)
if(side == 2) abline(v=xylim[1],col=col)
if(side == 3) abline(h=xylim[4],col=col)
if(side == 4) abline(v=xylim[2],col=col)
}
twoord.plot<-function(lx,ly,rx,ry,data=NULL,main="",xlim=NULL,lylim=NULL,
rylim=NULL,mar=c(5,4,4,4),lcol=1,rcol=2,xlab="",
lytickpos=NA,ylab="",ylab.at=NA,rytickpos=NA,rylab="",rylab.at=NA,
lpch=1,rpch=2,type="b",xtickpos=NULL,xticklab=NULL,halfwidth=0.4,
axislab.cex=1,do.first=NULL,xaxt="s",...) {
if(!is.null(data)) {
ly<-unlist(data[ly])
ry<-unlist(data[ry])
if(missing(lx)) lx<-1:length(ly)
else lx<-unlist(data[lx])
if(missing(rx)) rx <- 1:length(ry)
else rx<-unlist(data[rx])
}
if(missing(lx)) lx<-1:length(ly)
if(missing(ry)) {
if(missing(rx)) {
rx<-1:length(ry)
ry<-ly
ly<-lx
lx<-1:length(ly)
}
else {
ry<-rx
rx<-1:length(ry)
}
}
oldmar<-par("mar")
par(mar=mar)
if(is.null(xlim)) xlim<-range(c(lx,rx))
if(missing(lx)) lx<-1:length(ly)
if(is.null(lylim)) {
lylim<-range(ly,na.rm=TRUE)
lyspan<-diff(lylim)
if(lyspan == 0) lyspan<-lylim[1]
lylim[2]<-lylim[2]+lyspan*0.04
if(lylim[1] != 0) lylim[1]<-lylim[1]-lyspan*0.04
}
if(length(type) < 2) type<-rep(type,2)
# first display the "left" plot
if(match(type[1],"bar",0)) {
oldcex<-par(cex=axislab.cex)
plot(lx,ly,xlim=xlim,ylim=lylim,xlab=xlab,ylab="",yaxs="i",type="n",
main="",axes=FALSE,...)
par(oldcex)
if(!is.null(do.first)) eval(parse(text=do.first))
ybottom<-par("usr")[3]
if (lylim[1] < 0) abline(h=0,lty=2)
rect(lx-halfwidth,ifelse(ly<0,ly,ybottom),lx+halfwidth,
ifelse(ly>0,ly,0),col=lcol)
}
else {
oldcex<-par(cex=axislab.cex)
plot(lx,ly,xlim=xlim,ylim=lylim,xlab=xlab,ylab="",yaxs="i",type="n",
main="",axes=FALSE,...)
par(oldcex)
if(!is.null(do.first)) eval(parse(text=do.first))
points(lx,ly,col=lcol,pch=lpch,type=type[1],...)
}
title(main=main)
xylim<-par("usr")
#mtext(ylab,2,2,col=lcol,cex=axislab.cex)
box()
if(xaxt != "n") {
# display the X axis
if(inherits(lx,"POSIXt")) axis.POSIXct(1)
else {
if(is.null(xticklab)) axis(1,cex.axis=axislab.cex)
else {
if(is.null(xtickpos)) xtickpos<-1:length(xticklab)
axis(1,at=xtickpos,labels=xticklab,cex.axis=axislab.cex)
}
}
}
# display the left axis
if(is.na(lytickpos[1])) lytickpos<-pretty(ly)
if(is.na(ylab.at)) ylab.at<-mean(lytickpos)
color.axis(2,at=lytickpos,axlab=ylab,axlab.at=ylab.at,
col=ifelse(is.na(lcol),1,lcol),cex.axis=axislab.cex,cex = axislab.cex)
# get the "right" y limits
if(is.null(rylim)) {
rylim<-range(ry,na.rm=TRUE)
ryspan<-diff(rylim)
if(ryspan == 0) ryspan<-rylim[1]
rylim[2]<-rylim[2]+ryspan*0.04
if(rylim[1] != 0) rylim[1]<-rylim[1]-ryspan*0.04
}
# multiplier for the "right" y values
ymult<-diff(lylim)/diff(rylim)
# offset for the "right" y values
yoff<-lylim[1]-rylim[1]*ymult
if(match(type[2],"bar",0)) {
if(rylim[1] < 0) abline(h=0,lty=2)
rect(rx-halfwidth,ifelse(ry<0,ry,rylim[1]*ymult+yoff),rx+halfwidth,
ifelse(ry>0,ry*ymult+yoff,0),col=rcol)
}
else points(rx,ry*ymult+yoff,col=rcol,pch=rpch,type=type[2],...)
if(is.na(rytickpos[1])) rylabels<-pretty(rylim)
else rylabels<-rytickpos
if(min(rylabels) < rylim[1]) rylabels<-rylabels[rylabels >= rylim[1]]
if(max(rylabels) > rylim[2]) rylabels<-rylabels[rylabels <= rylim[2]]
axat<-rylabels*ymult+yoff
if(is.na(rylab.at)) rylab.at<-mean(rytickpos)
if(!is.na(rylab.at)) rylab.at<-rylab.at*ymult+yoff
# display the right axis
color.axis(4,at=axat,labels=rylabels,axlab=rylab,
axlab.at=rylab.at,col=ifelse(is.na(rcol),1,rcol),
cex.axis=axislab.cex,cex=axislab.cex)
par(mar=oldmar,new=FALSE,col.axis="black")
}
plotrix/R/barNest.R 0000755 0001762 0000144 00000005163 14011145766 013712 0 ustar ligges users barNest<-function (formula = NULL, data = NULL, FUN = c("mean", "sd",
"sd", "valid.n"), ylim = NULL, main = "", xlab = "", ylab = "",
shrink = 0.1, errbars = FALSE, col = NA, labelcex = 1, lineht = NULL,
showall = TRUE, Nwidths = FALSE, barlabels = NULL, showlabels = TRUE,
mar = NULL, arrow.cap = NULL, trueval = TRUE) {
if(inherits(data,"brklist")) x<-data
else x <- brkdnNest(formula = formula, data = data, FUN = FUN,
trueval = trueval)
getBreakListNames <- function(x) {
blnames <- list(names(x[[1]][[1]]))
for (level in 2:length(x[[1]])) blnames[[level]] <- dimnames(x[[1]][[level]])[[level -
1]]
return(blnames)
}
if (is.null(barlabels)) barlabels <- getBreakListNames(x)
xnames <- names(x)
nbn <- length(as.character(attr(terms(formula), "variables")[-1]))
if (FUN[1] == "valid.n" || FUN[1] == "sumbrk" || FUN[1] ==
"sum") {
if (is.null(ylim))
ylim <- c(0, 1.04 * max(unlist(x[[1]][[2]]), na.rm = TRUE))
if (FUN[1] == "valid.n" || FUN[1] == "sum")
barlabels[[1]] <- ""
}
intervals <- xnames[2] == xnames[3]
if (is.null(ylim)) {
if (errbars) {
if (intervals)
ylim <- c(min(unlist(x[[1]]), na.rm = TRUE) -
max(unlist(x[[3]]), na.rm = TRUE), max(unlist(x[[1]]),
na.rm = TRUE) + max(unlist(x[[2]]), na.rm = TRUE))
else ylim <- c(min(unlist(x[[3]]), na.rm = TRUE),
max(unlist(x[[2]]), na.rm = TRUE))
}
else ylim <- range(unlist(x[[1]]), na.rm = TRUE)
}
if (is.null(arrow.cap))
arrow.cap <- 0.25/length(unlist(x[[1]]))
ylim <- ylim + c(ifelse(ylim[1] < 0, -0.04, 0), 0.04) * diff(ylim)
if (ylim[1] != 0)
ylim[1] <- 0
if (!is.null(mar))
oldmar <- par(mar = mar)
plot(0, xlim = c(0, 1), ylim = ylim, main = main, xlab = xlab,
ylab = ylab, xaxt = "n", yaxs = "i", type = "n")
parusr <- par("usr")
if (is.null(lineht))
lineht <- 1.05 * labelcex * diff(parusr[3:4]) * (par("mai")[1]/par("pin")[2])/par("mar")[1]
nlevels = length(x[[1]])
drawNestedBars(x, start = 0, end = 1, shrink = shrink, errbars = errbars,
intervals = intervals, col = col, labelcex = labelcex,
lineht = lineht, showall = showall, Nwidths = Nwidths,
barlabels = barlabels, showlabels = showlabels, arrow.cap = arrow.cap)
abline(h = 0)
if (FUN[1] == "valid.n")
box()
if (!is.null(mar))
par(mar = oldmar)
invisible(x)
}
plotrix/R/gap.boxplot.R 0000755 0001762 0000144 00000012264 14114523773 014553 0 ustar ligges users gap.boxplot<-function (x, ..., gap = list(top = c(NA, NA), bottom = c(NA,
NA)), range = 1.5, width = NULL, varwidth = FALSE, notch = FALSE,
outline = TRUE, names, xlim = NA, ylim = NA, plot = TRUE,
border = par("fg"), col = NULL, log = "", axis.labels = NULL,
axes = TRUE, pars = list(boxwex = 0.8, staplewex = 0.5, outwex = 0.5),
horizontal = FALSE, add = FALSE, at = NULL, main = NULL,xlab="",ylab="")
{
if (!is.na(gap$top[1]))
if (gap$top[1] > gap$top[2])
gap$top <- rev(gap$top)
if (!is.na(gap$bottom[1]))
if (gap$bottom[1] > gap$bottom[2])
gap$bottom <- rev(gap$bottom)
if (is.na(ylim[1])) {
bxpt <- boxplot(x, ..., range = range, plot = FALSE)
ylim <- range(c(bxpt$stats, bxpt$out))
}
else bxpt <- boxplot(x, ..., ylim = ylim, range = range,
plot = FALSE)
bxgap <- bxpt
if (!is.na(gap$top[1])) {
bxgap$stats[bxgap$stats > gap$top[1] & bxgap$stats <
gap$top[2]] <- NA
if (any(is.na(bxgap$stats)))
stop("gap cannot include the median, interquartiles or the staples")
topdiff <- diff(gap$top)
bxgap$stats[bxgap$stats > gap$top[2]] <- bxgap$stats[bxgap$stats >
gap$top[2]] - topdiff
intopgap <- bxgap$out > gap$top[1] & bxgap$out < gap$top[2]
bxgap$out[intopgap] <- NA
abovetop <- which(bxgap$out > gap$top[2])
bxgap$out[abovetop] <- bxgap$out[abovetop] - topdiff
rangetop <- gap$top[1]
ylim[2] <- ylim[2] - topdiff
}
else rangetop <- ylim[2]
if (!is.na(gap$bottom[1])) {
bxgap$stats[bxgap$stats > gap$bottom[1] & bxgap$stats <
gap$bottom[2]] <- NA
if (any(is.na(bxgap$stats)))
stop("gap cannot include the median, interquartiles or the staples")
bottomdiff <- diff(gap$bottom)
bxgap$stats[bxgap$stats < gap$bottom[1]] <- bxgap$stats[bxgap$stats <
gap$bottom[1]] + bottomdiff
bxgap$out[bxgap$out > gap$bottom[1] & bxgap$out < gap$bottom[2]] <- NA
belowbottom <- which(bxgap$out < gap$bottom[1])
bxgap$out[belowbottom] <- bxgap$out[belowbottom] + bottomdiff
rangebottom <- gap$bottom[2]
ylim[1] <- ylim[1] + bottomdiff
}
else rangebottom <- ylim[1]
if (any(is.na(bxgap$out)))
warning("At least one outlier falls into a gap")
nboxes <- dim(bxgap$stats)[2]
if (is.na(xlim[1])) {
xlim <- c(0.5, nboxes + 0.5)
at <- 1:nboxes
}
bxgap$group <- at
plot(0, xlim = xlim, ylim = ylim, type = "n", axes = FALSE,
main = main,xlab=xlab, ylab=ylab)
plotlim <- par("usr")
box()
if (axes)
axis(1, labels = bxpt$names, at = at)
midticks <- pretty(c(rangebottom, rangetop))
if (axes)
axis(2, at = midticks[midticks > rangebottom & midticks <
rangetop])
if (is.null(width))
width <- pars$boxwex
rect(at - width/2, bxgap$stats[2, ], at + width/2, bxgap$stats[4,
], border = border, col = col)
if (notch) {
ymult <- getYmult()
if (is.null(col))
boxcol <- "white"
else boxcol <- col
rect(at - width/1.95, bxgap$conf[1, ], at + width/1.95,
bxgap$conf[2, ], border = NA, col = boxcol)
insets <- (bxgap$conf[2, ] - bxgap$conf[1, ]) * pars$boxwex/ymult
median.left <- ((at - width/2) + insets)
median.right <- ((at + width/2) - insets)
segments(at - width/2, bxgap$conf[1, ], median.left,
bxgap$stats[3, ], col = border)
segments(at - width/2, bxgap$conf[2, ], median.left,
bxgap$stats[3, ], col = border)
segments(median.right, bxgap$stats[3, ], at + width/2,
bxgap$conf[1, ], col = border)
segments(median.right, bxgap$stats[3, ], at + width/2,
bxgap$conf[2, ], col = border)
}
else {
median.left <- at - width/2
median.right <- at + width/2
}
segments(median.left, bxgap$stats[3, ], median.right, bxgap$stats[3,
], lwd = 2, col = border)
segments(at, bxgap$stats[1, ], at, bxgap$stats[2, ], lty = 2,
col = border)
segments(at, bxgap$stats[4, ], at, bxgap$stats[5, ], lty = 2,
col = border)
segments(at - pars$staplewex * width/2, bxgap$stats[1, ],
at + pars$staplewex * width/2, bxgap$stats[1, ], col = border)
segments(at - pars$staplewex * width/2, bxgap$stats[5, ],
at + pars$staplewex * width/2, bxgap$stats[5, ], col = border)
if (!is.na(gap$top[1]))
topadjust <- diff(gap$top)
else topadjust <- 0
if (!is.na(gap$bottom[1]))
bottomadjust <- diff(gap$bottom)
else bottomadjust <- 0
if (!is.null(axis.labels))
axis(2, labels = axis.labels, at = c(axis.labels[1] +
bottomadjust, axis.labels[2] - topadjust))
if (!is.na(gap$top[1]))
axis.break(2, gap$top[1], style = "gap")
if (!is.na(gap$bottom[1]))
axis.break(2, gap$bottom[2] - diff(plotlim[3:4]) * 0.02,
style = "gap")
points(bxpt$group,bxgap$out)
invisible(bxgap)
}
plotrix/R/plotCI.R 0000755 0001762 0000144 00000006544 14011145766 013512 0 ustar ligges users plotCI <- function (x, y = NULL, uiw, liw = uiw, ui = NULL, li = NULL,
err = "y", sfrac = 0.01, gap = 0, slty = par("lty"), add = FALSE,
scol = NULL, pt.bg = par("bg"), ...)
{
arglist <- list(...)
if (is.list(x)) {
y <- x$y
x <- x$x
}
if (is.null(y)) {
if (is.null(x))
stop("both x and y NULL")
y <- as.numeric(x)
x <- seq(along = x)
}
if (missing(uiw) && (is.null(ui) || is.null(li)))
stop("must specify either relative limits or both lower and upper limits")
if (!missing(uiw)) {
if (err == "y")
z <- y
else z <- x
ui <- z + uiw
li <- z - liw
}
if (is.null(arglist$xlab))
arglist$xlab <- deparse(substitute(x))
if (is.null(arglist$ylab))
arglist$ylab <- deparse(substitute(y))
if (err == "y" && is.null(arglist$ylim))
arglist$ylim <- range(c(y, ui, li), na.rm = TRUE)
if (err == "x" && is.null(arglist$xlim))
arglist$xlim <- range(c(x, ui, li), na.rm = TRUE)
if (missing(scol)) {
if (!is.null(arglist$col))
scol <- arglist$col
else scol <- par("col")
}
plotpoints <- TRUE
if (!is.null(arglist$pch) && is.na(arglist$pch)) {
arglist$pch <- 1
plotpoints <- FALSE
}
if (!add)
do.call("plot", c(list(x, y, type = "n"), clean.args(arglist,
plot)))
if (gap == TRUE)
gap <- 0.01
ul <- c(li, ui)
pin <- par("pin")
usr <- par("usr")
x.to.in <- pin[1]/diff(usr[1:2])
y.to.in <- pin[2]/diff(usr[3:4])
if (err == "y") {
gap <- rep(gap, length(x)) * diff(par("usr")[3:4])
smidge <- par("fin")[1] * sfrac
nz <- abs(li - pmax(y - gap, li)) * y.to.in > 0.001
scols <- rep(scol, length.out = length(x))[nz]
arrow.args <- c(list(lty = slty, angle = 90, length = smidge,
code = 1, col = scols), clean.args(arglist, arrows,
exclude.other = c("col", "lty", "axes")))
do.call("arrows", c(list(x[nz], li[nz], x[nz], pmax(y -
gap, li)[nz]), arrow.args))
nz <- abs(ui - pmin(y + gap, ui)) * y.to.in > 0.001
scols <- rep(scol, length.out = length(x))[nz]
arrow.args$col <- scols
do.call("arrows", c(list(x[nz], ui[nz], x[nz], pmin(y +
gap, ui)[nz]), arrow.args))
}
else if (err == "x") {
gap <- rep(gap, length(x)) * diff(par("usr")[1:2])
smidge <- par("fin")[2] * sfrac
nz <- abs(li - pmax(x - gap, li)) * x.to.in > 0.001
scols <- rep(scol, length.out = length(x))[nz]
arrow.args <- c(list(lty = slty, angle = 90, length = smidge,
code = 1, col = scols), clean.args(arglist, arrows,
exclude.other = c("col", "lty", "axes")))
do.call("arrows", c(list(li[nz], y[nz], pmax(x - gap,
li)[nz], y[nz]), arrow.args))
nz <- abs(ui - pmin(x + gap, ui)) * x.to.in > 0.001
scols <- rep(scol, length.out = length(x))[nz]
arrow.args$col <- scols
do.call("arrows", c(list(ui[nz], y[nz], pmin(x + gap,
ui)[nz], y[nz]), arrow.args))
}
if (plotpoints)
do.call("points", c(list(x, y, bg = pt.bg), clean.args(arglist,
points, exclude.other = c("xlab", "ylab", "xlim",
"ylim", "axes"))))
invisible(list(x = x, y = y))
}
plotrix/R/vectorField.R 0000755 0001762 0000144 00000002375 14011145766 014564 0 ustar ligges users # Arguments:
# u,v - the x (longitude) and y (latitude) offsets
# OR orientation and magnitude
# xpos,ypos - the centers of the vectors
# scale - the longest arrow as a proportion of the cell size
# headspan - the extent of the arrowhead as a proportion of cell size
# this function doesn't assume a 1:1 aspect ratio
vectorField<-function (u, v, xpos = NA, ypos = NA, scale = 1, headspan = 0.1,
vecspec = c("lonlat", "rad", "deg"), col = par("fg"))
{
udim <- dim(u)
if (is.na(xpos[1]))
xpos <- col(u)
if (is.na(ypos[1]))
ypos <- udim[1] - row(u) + 1
ymult <- getYmult()
if (match(vecspec[1], "lonlat", 0) == 0) {
if (match(vecspec[1], "deg", 0))
u <- pi * u/180
mag <- v
tempu <- v * cos(u)
v <- v * sin(u) * ymult
u <- tempu
}
else mag <- sqrt(u * u + v * v)
if (is.null(dim(xpos)))
maxmag <- 0.5 * max(diff(as.numeric(xpos)))/max(mag)
else maxmag <- 0.5 * max(diff(as.numeric(xpos[1, ])))/max(mag)
u2 <- u * scale * maxmag
v2 <- v * scale * maxmag
if (is.null(udim))
length = headspan
else length <- headspan * par("pin")[1]/udim[2]
arrows(xpos - u2, ypos - v2, xpos + u2, ypos + v2, length = length,
col = col)
}
plotrix/R/brkdn.plot.R 0000755 0001762 0000144 00000010336 14011145766 014367 0 ustar ligges users brkdn.plot<-function(vars,groups=NULL,obs=NULL,data,mct="mean",md="std.error",
stagger=NULL,dispbar=TRUE,main="Breakdown plot",xlab=NULL,ylab=NULL,xaxlab=NA,
ylim=NA,type="b",pch=1,lty=1,col=par("fg"),staxx=FALSE,yat=NULL,...) {
if(inherits(vars,"formula")) {
formbits<-all.vars(vars)
vars<-formbits[1]
groups<-formbits[2]
obs<-formbits[3]
}
if(is.null(obs)) {
if(is.null(groups[1]))
stop("Must have at least one factor to subset data")
bygroup<-as.factor(data[[groups]])
grouplevels<-levels(bygroup)
ngroups<-length(grouplevels)
nobs<-length(vars)
obs.pos<-1:nobs
obslevels<-1:nobs
}
else {
if(is.numeric(data[[obs]])) {
obs.pos<-obslevels<-sort(unique(data[[obs]]))
nobs<-length(obslevels)
}
else {
byobs<-as.factor(data[[obs]])
obslevels<-levels(byobs)
nobs<-length(obslevels)
obs.pos<-1:nobs
}
if(is.null(groups)) {
ngroups<-length(vars)
grouplevels<-1:ngroups
}
else {
bygroup<-as.factor(data[[groups]])
grouplevels<-levels(bygroup)
ngroups<-length(grouplevels)
if(length(vars) > 1) {
warning("Group and observation factors are present, only vars[1] is plotted")
vars<-vars[1]
}
}
}
brkdn<-list(matrix(NA,nrow=ngroups,ncol=nobs),
matrix(NA,nrow=ngroups,ncol=nobs))
if(is.null(groups)) {
if(is.null(xlab)) xlab<-"Observation"
xat<-1:nobs
if(is.na(xaxlab[1])) xaxlab<-obslevels
for(group in 1:ngroups) {
for(ob in 1:nobs) {
thisbit<-data[[vars[group]]][data[[obs]] == obslevels[ob]]
if(length(thisbit)) {
if(length(thisbit) > 1) {
brkdn[[1]][group,ob]<-do.call(mct,list(thisbit,na.rm=TRUE))
if(!is.null(md))
brkdn[[2]][group,ob]<-do.call(md,list(thisbit,na.rm=TRUE))
}
else brkdn[[1]][group,ob]<-thisbit
}
}
}
}
else {
if(is.na(obs)) {
if(is.na(xlab)) xlab<-"Variable"
xat<-1:length(vars)
if(is.na(xaxlab[1])) xaxlab<-vars
for(group in 1:ngroups) {
for(ob in 1:nobs) {
thisbit<-data[[vars[ob]]][data[[groups]] == grouplevels[group]]
if(length(thisbit)) {
if(length(thisbit) > 1) {
brkdn[[1]][group,ob]<-do.call(mct,list(thisbit,na.rm=TRUE))
if(!is.null(md))
brkdn[[2]][group,ob]<-do.call(md,list(thisbit,na.rm=TRUE))
}
else brkdn[[1]][group,ob]<-thisbit
}
}
}
}
else {
if(is.null(xlab)) xlab<-"Observation"
xat<-obs.pos
if(is.na(xaxlab[1])) xaxlab<-obslevels
for(group in 1:ngroups) {
for(ob in 1:nobs) {
thisbit<-data[[vars]][data[[groups]] == grouplevels[group] &
data[[obs]] == obslevels[ob]]
if(length(thisbit)) {
if(length(thisbit) > 1) {
brkdn[[1]][group,ob]<-do.call(mct,list(thisbit,na.rm=TRUE))
if(!is.null(md))
brkdn[[2]][group,ob]<-do.call(md,list(thisbit,na.rm=TRUE))
}
else brkdn[[1]][group,ob]<-thisbit
}
}
}
}
}
if(is.na(ylim[1])) {
ylim<-range(brkdn[[1]],na.rm=TRUE)
if(!is.null(md)) {
dlim<-c(min(brkdn[[1]]-brkdn[[2]],na.rm=TRUE),
max(brkdn[[1]]+brkdn[[2]],na.rm=TRUE))
ylim<-c(min(c(ylim[1],dlim[1])),max(c(ylim[2],dlim[2])))
}
}
groupdiv<-ifelse(ngroups < 3,1,ngroups-2)
if(is.null(stagger)) stagger<-0.025-groupdiv*0.0025
if(is.null(ylab)) {
if(length(vars) == 1) ylab<-vars[1]
else ylab<-paste(vars,collapse=" and ")
}
plot(0,xlim=c(obs.pos[1]-0.5,obs.pos[nobs]+0.5),main=main,
xlab=xlab,ylab=ylab,ylim=ylim,type="n",axes=FALSE,...)
box()
if(staxx) staxlab(at=xat,labels=xaxlab)
else axis(1,at=xat,labels=xaxlab)
if(is.null(yat)) axis(2)
else axis(2,at=yat)
if(length(pch) < ngroups) pch<-rep(pch,length.out=ngroups)
if(length(col) < ngroups) col<-rep(col,length.out=ngroups)
if(length(lty) < ngroups) lty<-rep(lty,length.out=ngroups)
offinc<-stagger*diff(par("usr")[c(1,2)])
offset<-0
arrow.cap<-0.01-(groupdiv*0.001)
for(group in 1:ngroups) {
points(obs.pos+offset,brkdn[[1]][group,],type=type,col=col[group],
pch=pch[group],lty=lty[group],...)
if(dispbar)
dispersion(obs.pos+offset,brkdn[[1]][group,],brkdn[[2]][group,],
arrow.cap=arrow.cap,col=col[group],...)
offset<-ifelse(offset<0,-offset,-offset-offinc)
}
names(brkdn)<-c(mct,md)
return(brkdn)
}
plotrix/R/zoomInPlot.R 0000755 0001762 0000144 00000003372 14011145766 014426 0 ustar ligges users zoomInPlot<-function(x,y=NULL,xlim=NULL,ylim=NULL,rxlim=xlim,rylim=ylim,
xend=NA,zoomtitle=NULL,titlepos=NA,...) {
par(mfrow=c(1,2))
if(is.null(y)) {
y<-x
x<-1:length(x)
}
if(is.null(xlim[1])) xlim<-range(x)
if(is.null(ylim[1])) ylim<-range(y)
plot(x,y,xlim=xlim,ylim=ylim,...)
xext<-yext<-rxext<-ryext<-0
if(par("xaxs") == "r") {
xext<-diff(xlim)*0.04
rxext<-diff(rxlim)*0.04
}
if(par("yaxs") == "r") {
yext<-diff(ylim)*0.04
ryext<-diff(rylim)*0.04
}
if(is.na(rxlim[1])) {
newbox<-locator(2)
rxlim<-sort(newbox$x)
rylim<-sort(newbox$y)
}
rect(rxlim[1]-rxext,rylim[1]-ryext,rxlim[2]+rxext,rylim[2]+ryext)
xylim<-par("usr")
xypin<-par("pin")
rxi0<-xypin[1]*(xylim[2]-(rxlim[1]-rxext))/diff(xylim[1:2])
rxi1<-xypin[1]*(xylim[2]-(rxlim[2]+rxext))/diff(xylim[1:2])
y01i<-xypin[2]*(xylim[4]-(rylim[2]+ryext))/diff(xylim[3:4])
y02i<-xypin[2]*((rylim[1]-ryext)-xylim[3])/diff(xylim[3:4])
plot(x,y,xlim=rxlim,ylim=rylim,...)
xypin<-par("pin")
par(xpd=NA)
xylim<-par("usr")
xymai<-par("mai")
x0<-xylim[1]-diff(xylim[1:2])*(xymai[2]+xymai[4]+rxi0)/xypin[1]
x1<-xylim[1]-diff(xylim[1:2])*(xymai[2]+xymai[4]+rxi1)/xypin[1]
y01<-xylim[4]-diff(xylim[3:4])*y01i/xypin[2]
y02<-xylim[3]+diff(xylim[3:4])*y02i/xypin[2]
par(xpd=TRUE)
if(!is.null(zoomtitle)) {
if(is.na(titlepos)) titlepos<-getFigCtr()[1]
mtext(zoomtitle,at=titlepos,cex=1.5,line=1.5)
}
if(is.na(xend)) xend<-xylim[1]-diff(xylim[1:2])*xymai[2]/(2*xypin[1])
xprop0<-(xylim[1]-xend)/(xylim[1]-x0)
xprop1<-(xylim[2]-xend)/(xylim[2]-x1)
par(xpd=NA)
segments(c(x0,x0,x1,x1),c(y01,y02,y01,y02),
c(xend,xend,xend,xend),
c(xylim[4]-(xylim[4]-y01)*xprop0,xylim[3]+(y02-xylim[3])*xprop0,
xylim[4]-(xylim[4]-y01)*xprop1,xylim[3]+(y02-xylim[3])*xprop1))
par(xpd=FALSE,mfrow=c(1,1))
}
plotrix/R/feather.plot.R 0000755 0001762 0000144 00000001420 14011145766 014677 0 ustar ligges users feather.plot<-function(r,theta,xpos,yref=0,use.arrows=TRUE,
col.refline="lightgray",fp.type="s",main="",xlab="",ylab="",
xlabels=NULL,...) {
if(missing(xpos)) xpos<-1:length(theta)
# reverse the angles and start at 12 o'clock
if(fp.type == "m") theta<-5*pi/2-theta
x<-r*cos(theta)
y<-r*sin(theta)
xmult<-diff(range(xpos))/(diff(range(y))*2)
x<-x*xmult
xlim<-range(c(xpos,x+xpos))
ylim<-range(c(y,yref))
oldpin<-par("pin")
xdiff<-xlim[2]-xlim[1]
ydiff<-ylim[2]-ylim[1]
plot(0,xlim=xlim,ylim=ylim,type="n",main=main,xlab=xlab,ylab=ylab,axes=FALSE)
box()
if(is.null(xlabels)) axis(1)
else axis(1,at=xpos,labels=xlabels)
abline(h=yref,col=col.refline)
if(use.arrows) arrows(xpos,yref,xpos+x,y,length=0.1,...)
else segments(xpos,yref,xpos+x,y,...)
par(pin=oldpin)
}
plotrix/R/spread.labels.R 0000755 0001762 0000144 00000004207 14011145766 015031 0 ustar ligges users spread.labels<-function (x,y,labels=NULL,ony=NA,offsets=NA,between=FALSE,
linecol=par("fg"),srt=0,...) {
if(missing(x))
stop("Usage: spread.labels(x,y,labels,...)")
nx<-length(x)
ny<-length(y)
if(is.na(ony)) {
xylim<-par("usr")
ony<-diff(range(x))/(xylim[2]-xylim[1]) 0) || all(offsets < 0))
seggaps<-rep(seggap*(all(offsets)<0)*-1,length.out=nx)
else seggaps<-rep(c(seggap,-seggap),length.out=nx)
segments(newx,y+offsets-seggaps,x,y)
}
}
}
plotrix/R/gantt.R 0000755 0001762 0000144 00000011011 14011145766 013416 0 ustar ligges users get.gantt.info<-function(format="%Y/%m/%d") {
cat("Enter the label, start and finish time for each task.\n")
cat("Default format for time is year/month/day e.g. 2005/2/22\n")
cat("Enter a blank label to end.\n")
nextlabel<-"dummy"
tasklabels<-NA
taskstarts<-NA
taskends<-NA
priorities<-NA
while(nchar(nextlabel)) {
nextlabel<-readline("Task label - ")
if(nchar(nextlabel)) {
if(is.na(tasklabels[1])) tasklabels<-nextlabel
else tasklabels<-c(tasklabels,nextlabel)
nextstart<-as.POSIXct(strptime(readline("Task begins - "),format=format))
if(is.na(taskstarts[1])) taskstarts<-nextstart
else taskstarts<-c(taskstarts,nextstart)
nextend<-nextstart-1
while(nextend < nextstart) {
nextend<-as.POSIXct(strptime(readline("Task ends - "),format=format))
if(nextend < nextstart) cat("Task cannot end before it starts!\n")
else {
if(is.na(taskends[1])) taskends<-nextend
else taskends<-c(taskends,nextend)
}
}
nextpriority<-0
while (nextpriority < 1 || nextpriority > 10) {
nextpriority <- as.numeric(readline("Task priority (1-10) - "))
if(is.na(nextpriority)) {
cat("Task priority must be a number between 1 and 10!\n")
next.priority<-0
}
}
if(is.na(priorities[1])) priorities<-nextpriority
else priorities<-c(priorities,nextpriority)
}
}
return(list(labels=tasklabels,starts=taskstarts,ends=taskends,
priorities=priorities))
}
gantt.chart<-function (x=NULL,format="%Y/%m/%d",xlim=NULL,
taskcolors=NULL,priority.legend=FALSE,vgridpos=NULL,vgridlab=NULL,
vgrid.format="%Y/%m/%d",half.height=0.25,hgrid=FALSE,main="",xlab="",
cylindrical=FALSE,label.cex=1,border.col=NA,priority.label="Priorities",
priority.extremes=c("High","Low"),time.axis=3) {
oldpar <- par("mai", "omi", "xpd", "xaxs", "yaxs")
if(is.null(x)) x<-get.gantt.info(format=format)
if(any(x$starts > x$ends))
stop("Can't have a start date after an end date")
tasks<-unique(x$labels)
ntasks<-length(tasks)
if(is.null(x$priorities)) x$priorities<-rep(1,ntasks)
if (is.null(dev.list())) plot.new()
charheight<-strheight("M",units="inches")
oldcex<-par(cex=label.cex)
maxwidth<-max(strwidth(x$labels,units="inches")) + 0.3
par(oldcex)
if(is.null(xlim)) xlim<-range(c(x$starts,x$ends))
npriorities<-max(x$priorities)
if(is.null(taskcolors)) taskcolors<-barcolors<-rainbow(npriorities)
else barcolors <- taskcolors
if(length(barcolors) < ntasks) barcolors<-barcolors[x$priorities]
nlabels<-length(x$labels)
bottom.margin <- ifelse(time.axis == 3, 0.8, 1.3)
if(length(barcolors) < nlabels)
barcolors<-barcolors[as.numeric(factor(x$labels))]
par(mai=c(bottom.margin,maxwidth,charheight*4*(1+(nchar(main) > 0)),0.1))
par(omi=c(0.1,0.1,0.1,0.1),xaxs="i",yaxs="i")
plot(range(x$starts),c(1,ntasks),xlim=xlim,ylim=c(0.5,ntasks+0.5),
main="",xlab="",ylab="",axes=FALSE,type = "n")
box()
if(nchar(main)) mtext(main,side=3,line=2.5,cex=par("cex.main"),
col=par("col.main"))
if(nchar(xlab)) mtext(xlab,1,1)
if(is.na(vgrid.format)) {
if(is.null(vgridlab)) vgridlab<-vgridpos
axis(time.axis,at=vgridpos,labels=vgridlab,padj=0)
tickpos<-vgridpos
}
else {
if(is.null(vgridpos))
tickpos<-axis.POSIXct(3,xlim,format=vgrid.format)
else tickpos<-vgridpos
if(is.null(vgridlab) && !is.null(vgridpos))
vgridlab<-format.POSIXct(vgridpos,vgrid.format)
if(is.null(vgridlab))
axis.POSIXct(3,xlim,format=vgrid.format)
else axis(time.axis,at=tickpos,labels=vgridlab,padj=0)
}
topdown<-seq(ntasks,1)
axis(2,at=topdown,labels=tasks,las=2,cex.axis=label.cex)
abline(v=tickpos,col="darkgray",lty=3,lwd=2)
for(i in 1:ntasks) {
if(cylindrical)
cylindrect(x$starts[x$labels==tasks[i]],topdown[i] -
half.height,x$ends[x$labels==tasks[i]],topdown[i] +
half.height,col=barcolors[i],gradient="y")
else rect(x$starts[x$labels==tasks[i]],topdown[i] -
half.height,x$ends[x$labels==tasks[i]],topdown[i]+half.height,
col=barcolors[x$labels==tasks[i]],border=border.col)
}
if(hgrid)
abline(h=(topdown[1:(ntasks-1)]+topdown[2:ntasks])/2,
col="darkgray",lty=3,lwd=2)
if(priority.legend) {
par(xpd=TRUE)
plim<-par("usr")
plot.width<-diff(plim[1:2])
line.height<-strheight("W")
color.legend(plim[1]+2*plot.width/5,
plim[3]-(6.5-time.axis)*line.height,
plim[1]+3*plot.width/5,plim[3]-(5.5-time.axis)*line.height,
legend=c(priority.extremes[1],rep("",length(taskcolors)-2),
priority.extremes[2]),rect.col=taskcolors)
par(xpd=NA)
text(plim[1]+plot.width/2,plim[3]-(7-time.axis)*line.height,
priority.label,adj=c(0.5,1))
par(xpd = FALSE)
}
par(oldpar)
invisible(x)
}
plotrix/R/draw.ellipse.R 0000755 0001762 0000144 00000004711 14011145766 014703 0 ustar ligges users draw.ellipse<-function(x,y,a=1,b=1,angle=0,segment=NULL,arc.only=TRUE,
deg=TRUE,nv=100,border=NULL,col=NA,lty=1,lwd=1,...) {
if(is.null(segment)) {
# set segment to full ellipse if not supplied
if(deg) segment<-c(0,360)
else segment<-c(0,2*pi)
}
## workhorse internal function draw ellipse
draw1ellipse <-
function(x, y, a = 1, b = 1, angle = 0, segment=NULL,
arc.only=TRUE, nv = 100, deg = TRUE, border=NULL, col=NA, lty=1, lwd=1, ...)
{
# if input is in degrees
if (deg) {
angle <- angle * pi/180
segment <- segment * pi/180
}
z <- seq(segment[1], segment[2], length = nv + 1)
xx <- a * cos(z)
yy <- b * sin(z)
alpha <- xyangle(xx, yy, directed = TRUE, deg = FALSE)
rad <- sqrt(xx^2 + yy^2)
xp <- rad * cos(alpha + angle) + x
yp <- rad * sin(alpha + angle) + y
if (!arc.only) {
xp <- c(x, xp, x)
yp <- c(y, yp, y)
}
polygon(xp, yp, border=border, col=col, lty=lty, lwd=lwd, ...)
invisible(NULL)
}
## internal function for the internal function
xyangle <-
function(x, y, directed = FALSE, deg = TRUE)
{
if (missing(y)) {
y <- x[,2]
x <- x[,1]
}
out <- atan2(y, x)
if (!directed)
out <- out %% pi
if (deg) # if output is desired in degrees
out <- out * 180 / pi
out
}
if (missing(y)) {
y <- x[,2]
x <- x[,1]
}
n <- length(x)
if (length(a) < n)
a <- rep(a, n)[1:n]
if (length(b) < n)
b <- rep(b, n)[1:n]
if (length(angle) < n)
angle <- rep(angle, n)[1:n]
if (length(col) < n)
col <- rep(col, n)[1:n]
if (length(border) < n)
border <- rep(border, n)[1:n]
if (length(nv) < n)
nv <- rep(nv, n)[1:n]
if(n==1)
draw1ellipse(x,y,a,b,angle=angle,segment=segment,
arc.only=arc.only,deg=deg,nv=nv,col=col,border=border,
lty=lty,lwd=lwd,...)
else {
if (length(segment) < 2*n)
segment <- matrix(rep(segment,n), n, 2, byrow=TRUE)
lapply(1:n, function(i) draw1ellipse(x[i], y[i], a[i], b[i],
angle=angle[i], segment=segment[i,], arc.only=arc.only, deg=deg,
nv=nv[i], col=col[i], border=border[i],
lty=lty, lwd=lwd, ...))
}
invisible(NULL)
}
plotrix/R/dendroPlot.R 0000644 0001762 0000144 00000003356 14011145766 014425 0 ustar ligges users dendroPlot<-function(x,breaks=list(10,10,10),pch=1,col=par("fg"),cex=1,nudge=NA,
setlabels=NA,...) {
plot(c(0.5,length(x)+0.5),range(unlist(sapply(x,as.numeric))),
type="n",xaxt="n",...)
lenx<-length(x)
if(is.na(setlabels[1])) setlabels<-paste("Group",1:lenx)
axis(1,at=1:lenx,labels=setlabels)
if(is.na(nudge[1])) nudge<-strwidth("o")
if(length(pch) < lenx) pch<-rep(pch,length.out=lenx)
if(length(col) < lenx) col<-rep(col,length.out=lenx)
for(list_element in 1:length(x)) {
if(is.character(x[[list_element]]))
x[[list_element]]<-factor(x[[list_element]])
if(is.factor(x[[list_element]])) nbins<-length(levels(x[[list_element]]))
else {
xbreaks<-cut(x[[list_element]],breaks=breaks[[list_element]])
nbins<-length(levels(xbreaks))
}
for(bin in 1:nbins) {
if(is.factor(x[[list_element]])) {
thisbin<-which(as.numeric(x[[list_element]])==bin)
npoints<-length(thisbin)
}
else {
thisbin<-which(as.numeric(xbreaks)==bin)
npoints<-length(thisbin)
}
if(npoints) {
if(npoints==1) offsetx<-offsety<-0
else {
offsetx<-(c(0,trunc(seq(1,npoints/2,by=0.5)))*nudge[1])[1:npoints]
# only apply the vertical nudge for factors
if(length(nudge) > 1 && is.factor(x[[list_element]]))
offsety<-c(0,rep(c(nudge[2],nudge[2],-nudge[2],-nudge[2]),
length.out=npoints-1))
else offsety<-rep(0,length(offsetx))
}
if(length(offsetx) > 3 )
offsetx[seq(2,length(offsetx),by=2)]<-
-offsetx[seq(2,length(offsetx),by=2)]
else if(length(offsetx) == 3 ) offsetx[2]<--offsetx[2]
points(list_element+offsetx,
sort(as.numeric(x[[list_element]][thisbin]))+offsety,
pch=pch[list_element],col=col[list_element])
}
}
}
}
plotrix/R/arctext.R 0000755 0001762 0000144 00000002447 14011145766 013770 0 ustar ligges users arctext<-function(x,center=c(0,0),radius=1,start=NULL,middle=pi/2,end=NULL,
stretch=1,clockwise=TRUE,cex=NULL, ...) {
oldcex <- par("cex")
# have to do this to get strwidth to work
if(is.null(cex)) cex <- oldcex
par(cex = cex)
xvec <- strsplit(x, "")[[1]]
lenx <- length(xvec)
xwidths <- stretch * strwidth(xvec)
charangles <- xwidths/radius
# make really narrow characters wider
changrang <- range(charangles)
charangles[charangles < changrang[2]/2] <- changrang[2]/2
if(!is.null(end)) {
if(clockwise) start <- end + sum(charangles)
else start <- end - sum(charangles)
}
if(is.null(start)) {
if (clockwise) start <- middle + sum(charangles)/2
else start <- middle - sum(charangles)/2
}
if(clockwise) {
charstart <- c(start, start - cumsum(charangles)[-lenx])
charpos <- charstart - charangles/2
}
else {
charstart <- c(start, start + cumsum(charangles)[-lenx])
charpos <- charstart + charangles/2
}
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
for(xchar in 1:lenx) {
srt <- 180 * charpos[xchar]/pi - 90
text(center[1] + radius * cos(charpos[xchar]), center[2] +
radius * sin(charpos[xchar]) * ymult, xvec[xchar],
adj = c(0.5, 0.5), srt = srt + 180 * (!clockwise),...)
}
par(cex = oldcex)
}
plotrix/R/tsxpos.R 0000644 0001762 0000144 00000000703 14011145766 013644 0 ustar ligges users tsxpos<-function(x,xlim,nint) {
# make sure that there is a graphics device open
if(dev.cur() == 1) stop("A graphics device must be open")
if(missing(xlim)) {
plotlim<-par("usr")
divlim<-ifelse(par("xaxs") == "r",0.04,0)
xrange<-(plotlim[2]-plotlim[1])/(1+2*divlim)
xstart<-plotlim[1]+xrange*divlim
}
else {
xstart<-xlim[1]
xrange<-diff(xlim)
}
if(missing(nint)) nint<-length(x)-1
return(cumsum(c(xstart,rep(xrange/nint,nint))))
}
plotrix/R/size_n_color.R 0000644 0001762 0000144 00000003565 14011145766 015002 0 ustar ligges users size_n_color<-function(x=NULL,y,size,sizefun="sqrt",col,main="",
xlim=NA,xlab="",xat=NULL,xaxlab=NULL,xcex=1,xlas=0,xgrid=FALSE,
ylim=NA,ylab="",yat=NULL,yaxlab=NULL,ycex=1,ylas=1,ygrid=TRUE,
mar=c(5,4,4,2),boxit=TRUE,add=FALSE,...) {
if(!is.na(sizefun)) size<-do.call(sizefun,list(size))
if(is.matrix(size)) {
dimsize<-dim(size)
if(is.null(x)) {
x<-matrix(rep((1:dimsize[2])*max(size*2),each=dimsize[1]),ncol=dimsize[2])
y<-matrix(rep((dimsize[1]:1)*max(size*2),dimsize[2]),ncol=dimsize[2])
if(is.null(xat)) xat<-x[1,]
if(is.null(yat)) yat<-y[,1]
}
else {
if(is.null(xat)) xat<-1:dimsize[2]
if(is.null(yat)) yat<-1:dimsize[1]
}
}
else {
dimsize=c(length(size),1)
if(is.null(x)) x<-1:length(size)
}
xylim<-par("usr")
aspect_ratio<-(xylim[2]-xylim[1])/(xylim[4]-xylim[3])
maxsize<-max(size)
if(is.na(xlim[1]))
xlim<-c(min(x)-maxsize*aspect_ratio,max(x)+maxsize*aspect_ratio)
if(is.na(ylim[1]))
ylim<-c(min(y)-maxsize/aspect_ratio,max(y)+maxsize/aspect_ratio)
if(!add) {
oldmar<-par(mar=mar)
plot(x,y,main=main,xlab=xlab,ylab=ylab,xlim=xlim,ylim=ylim,
axes=FALSE,type="n",...)
if(xgrid) segments(xat,xylim[3],xat,xylim[4],col="lightgray",lty=2)
if(ygrid) segments(xylim[1],yat,xylim[2],yat,col="lightgray",lty=2)
axis(1,at=xat,labels=xaxlab,las=xlas,cex.axis=xcex)
axis(2,at=yat,labels=yaxlab,las=ylas,cex.axis=ycex)
if(boxit) box()
}
if(is.matrix(size)) {
if(is.null(dim(col))) col=matrix(col,nrow=dimsize[1],ncol=dimsize[2])
for(row in 1:dimsize[1]) {
for(column in 1:dimsize[2])
draw.circle(x[row,column],y[row,column],size[row,column],
border=NA,col=col[row,column])
}
}
else {
if(length(col) < length(size)) col=rep(col,size)
for(index in 1:length(size))
draw.circle(x[index],y[index],size[index],border=NA,col=col[index])
}
if(!add) par(mar=oldmar)
}
plotrix/R/dotplot.mtb.R 0000755 0001762 0000144 00000003654 14011145766 014565 0 ustar ligges users dotplot.mtb <- function (x, xlim = NULL, main = NULL, xlab = NULL, ylab=NULL,
pch = 19, hist=FALSE, yaxis=FALSE, mtbstyle=TRUE)
{
if (is.null(xlim))
xlim <- range(pretty(range(x,na.rm=TRUE)))
if (is.null(main))
main <- ""
if (is.null(xlab))
xlab <- ""
if (is.null(ylab))
ylab <- ""
x <- sort(x)
w <- table(x)
if(hist) {
x <- as.numeric(names(w))
w <- unname(unclass(w))
} else w <- unlist(lapply(w, function(n) { 1:n }))
mw <- max(w)
Nmax <- floor(par()$pin[2]/strheight("o",units="inches"))
top <- if(mtbstyle) Nmax/2 else Nmax
if(mw <= top & !hist) {
plot(range(x, na.rm = TRUE), c(0, 1), type = "n", xlab = "",
ylab = "", xlim = xlim, main = main, axes = FALSE)
yr <- if(mtbstyle) c(-Nmax/2,Nmax/2) else c(0,Nmax)
par(usr = c(par()$usr[1:2], yr[1], yr[2]))
y <- strheight("o") * w
points(x, y, pch = pch)
axis(side = 1, pos = 0)
if(xlab!="") axis(side=1,at=0.5*sum(xlim),pos=-2,labels=xlab,tick=FALSE)
if(ylab!="") axis(side=2,at=0.5*yr[2],line=2,labels=ylab,tick=FALSE)
if(yaxis) {
b <- max(1,ceiling(top/10))
ll <- 1+floor(top/b)
at <- seq(0,by=b,length=ll)
axis(side = 2,at=at)
}
} else {
nt <- mw+1
yr <- if(mtbstyle) c(-nt,nt) else c(0,nt)
if(hist) plot(x,w,type="h",xlab="",ylab="",xlim=xlim,
ylim=yr,main=main,axes=FALSE)
else plot(x,w,pch=pch,xlab="",ylab="",xlim=xlim,
ylim=yr,main=main,axes=FALSE)
pos <- if(mtbstyle) -0.02*mw else 0
axis(side = 1,pos = pos)
if(mtbstyle) {
if(xlab!="") axis(side=1,at=0.5*sum(xlim),pos=-2,labels=xlab,tick=FALSE)
if(ylab!="") axis(side=2,at=0.5*yr[2],line=2,labels=ylab,tick=FALSE)
} else {
if(xlab!="") title(xlab=xlab)
if(ylab!="") title(ylab=ylab)
}
if(yaxis) {
b <- max(1,ceiling(nt/10))
ll <- 1+floor(nt/b)
at <- seq(0,by=b,length=ll)
axis(side = 2,at=at)
}
}
}
plotrix/R/paxis3d.R 0000755 0001762 0000144 00000007374 14011145766 013675 0 ustar ligges users # 'enhanced' persp -- return value has attributes containing
# x,y,z ranges
perspx <- function(x,y,z,...) {
if (missing(z)) {
if (!missing(x)) {
if (is.list(x)) {
z <- x$z
y <- x$y
x <- x$x
}
else {
z <- x
x <- seq.int(0, 1, length.out = nrow(z))
}
}
else stop("no 'z' matrix specified")
}
else if (is.list(x)) {
y <- x$y
x <- x$x
}
p <- persp(x,y,z,...)
attr(p,"ranges") <- list(x=range(x),y=range(y),z=range(z))
p
}
psegments3d <- function(x, y = NULL, z = NULL, pmat, ...) {
if (is.null(y) && is.null(z)) {
z <- x$z
y <- x$y
x <- x$x
}
xy <- trans3d(x,y,z,pmat)
# translate from 'segments3d' (successive pairs) to
# 'segments' (x0,x1,y0,y1) format
n <- length(xy$x)
x0 <- xy$x[seq(1,n,by=2)]
x1 <- xy$x[seq(2,n,by=2)]
y0 <- xy$y[seq(1,n,by=2)]
y1 <- xy$y[seq(2,n,by=2)]
segments(x0=x0,x1=x1,y0=y0,y1=y1,...)
}
ptext3d <- function(x, y = NULL, z = NULL, texts, pmat, ...) {
if (is.null(y) && is.null(z)) {
z <- x$z
y <- x$y
x <- x$x
}
do.call(text,c(trans3d(x,y,z,pmat),list(label=texts,...)))
}
if (FALSE) {
pp <- persp(x=1:3,y=1:3,z=matrix(1:9,nrow=3),col="gray")
ptext3d(2,2,5,"a",pp,col="red")
}
get_axispos3d <- function(edge,pmat,at,pos=NULL, dist=0) {
ranges <- attr(pmat,"ranges")
edge <- c(strsplit(edge, "")[[1]], "-", "-")[1:3]
coord <- match(toupper(edge[1]), c("X", "Y", "Z"))
if (coord == 2)
edge[1] <- edge[2]
else if (coord == 3)
edge[1:2] <- edge[2:3]
mpos <- matrix(NA, 3, length(at))
if (edge[1] == "+")
mpos[1, ] <- ranges$x[2]
else mpos[1, ] <- ranges$x[1]
if (edge[2] == "+")
mpos[2, ] <- ranges$y[2]
else mpos[2, ] <- ranges$y[1]
if (edge[3] == "+")
mpos[3, ] <- ranges$z[2]
else mpos[3, ] <- ranges$z[1]
offset <- dist * (mpos[, 1] - c(mean(ranges$x), mean(ranges$y),
mean(ranges$z)))
offset[coord] <- 0
mpos <- sweep(mpos,1,offset,"+")
if (!is.null(pos))
mpos <- matrix(pos, 3, length(at))
mpos[coord, ] <- at
mpos
}
mtext3d <- function (edge, pmat, labels = TRUE, at = NULL, dist=0.3, xpd=NA, ...) {
ranges <- attr(pmat,"ranges")
edge.orig <- edge # hack
edge <- c(strsplit(edge, "")[[1]], "-", "-")[1:3]
coord <- match(toupper(edge[1]), c("X", "Y", "Z"))
range <- ranges[[coord]]
if (is.null(at)) {
at <- mean(range)
}
mpos <- get_axispos3d(edge.orig,pmat,at,dist=dist)
ptext3d(mpos[1, ],mpos[2,],mpos[3,],
labels, pmat, xpd=xpd, ...)
}
paxis3d <-
function (edge, pmat,
at = NULL, labels = TRUE, tick = TRUE,
pos = NULL, nticks = 5, ticklen=0.05,labdist=0.15,
xpd=NA, ...)
{
ranges <- attr(pmat,"ranges")
edge.orig <- edge # hack
edge <- c(strsplit(edge, "")[[1]], "-", "-")[1:3]
coord <- match(toupper(edge[1]), c("X", "Y", "Z"))
range <- ranges[[coord]]
if (is.null(at)) {
at <- pretty(range, nticks)
at <- at[at >= range[1] & at <= range[2]]
}
if (is.logical(labels)) {
if (labels)
labels <- format(at)
else labels <- NA
}
mpos <- get_axispos3d(edge.orig,pmat,at,pos,dist=0)
# draw axes
x <- c(mpos[1, 1], mpos[1, length(at)])
y <- c(mpos[2, 1], mpos[2, length(at)])
z <- c(mpos[3, 1], mpos[3, length(at)])
psegments3d(x,y,z,pmat, xpd=xpd, ...)
if (tick) {
mpos_tick <- get_axispos3d(edge.orig,pmat,at,dist=ticklen)
x <- c(as.double(rbind(mpos[1, ], mpos_tick[1, ])))
y <- c(as.double(rbind(mpos[2, ], mpos_tick[2, ])))
z <- c(as.double(rbind(mpos[3, ], mpos_tick[3, ])))
psegments3d(x,y,z,pmat, xpd=xpd, ...)
}
if (!is.null(labels)) {
mpos_lab <- get_axispos3d(edge.orig,pmat,at,dist=labdist)
ptext3d(mpos_lab[1, ],mpos_lab[2,],mpos_lab[3,],
labels, pmat, xpd=xpd, ...)
}
}
plotrix/R/gap.plot.R 0000755 0001762 0000144 00000013520 14011145766 014034 0 ustar ligges users # Try to rewrite this for an arbitrary number of gaps
gap.plot<-function(x,y,gap,gap.axis="y",bgcol="white",breakcol="black",
brw=0.02,xlim=range(x),ylim=range(y),xticlab,xtics=NA,yticlab,ytics=NA,
lty=rep(1,length(x)),col=rep(par("col"),length(x)),pch=rep(1,length(x)),
add=FALSE,stax=FALSE,...) {
if(missing(y) && !missing(x)) {
y<-x
x<-1:length(y)
}
if(missing(gap)) stop("gap must be specified")
gapsize<-diff(gap)
xaxl<-par("xlog")
yaxl<-par("ylog")
if(gap.axis == "y") {
if(length(gap) > 3) ylim[2]<-ylim[2] - (gapsize[1] + gapsize[3])
else ylim[2]<-ylim[2]-gapsize[1]
}
if(gap.axis == "x") {
if(length(gap) > 3) xlim[2]<-xlim[2] - (gapsize[1] + gapsize[3])
else xlim[2]<-xlim[2]-gapsize[1]
}
rangexy <- c(range(xlim),range(ylim))
xgw<-(rangexy[2]-(rangexy[1]+gapsize))*brw
ygw<-(rangexy[4]-(rangexy[3]+gapsize))*brw
if(is.na(xtics[1])) xtics<-pretty(x)
if(is.na(ytics[1])) ytics<-pretty(y)
if(missing(xticlab)) xticlab<-xtics
if(missing(yticlab)) yticlab<-ytics
if(length(col) < length(y)) col<-rep(col,length.out=length(y))
if(gap.axis == "y") {
littleones<-which(y < gap[1])
if(length(gap) > 3) {
middleones<-which(y >= gap[2] + ygw & y < gap[3])
bigones<-which(y >= gap[4] + ygw)
lostones<-sum(c(y > gap[1] & y < gap[2] + ygw,y > gap[3] & y < gap[4] + ygw))
}
else {
middleones<-NA
bigones<-which(y >= gap[2] + ygw)
lostones<-sum(y > gap[1] & y < gap[2] + ygw)
}
if(lostones) warning("some values of y may not be displayed")
}
else {
littleones<-which(x < gap[1])
if(length(gap) > 3) {
middleones<-which(x >= gap[2] + xgw & x < gap[3])
bigones<-which(x >= gap[4] + xgw)
lostones<-sum(c(x > gap[1] & x < gap[2] + xgw,x > gap[3] & x < gap[4] + xgw))
if(missing(xlim)) xlim<-c(min(x),max(x) - (gapsize[1] + gapsize[3]))
}
else {
middleones<-NA
bigones<-which(x >= gap[2])
lostones<-sum(x > gap[1] & x < gap[2] + xgw)
if(missing(xlim)) xlim<-c(min(x),max(x) - gapsize[1])
}
if(lostones) warning("some values of x will not be displayed")
if(missing(ylim)) ylim<-range(y)
}
if(length(lty) < length(x)) lty<-rep(lty,length.out=length(x))
if(length(col) < length(x)) col<-rep(col,length.out=length(x))
if(length(pch) < length(x)) pch<-rep(pch,length.out=length(x))
if(add) {
points(x[littleones],y[littleones],lty=lty[littleones],
col=col[littleones],pch=pch[littleones],...)
if(gap.axis == "y") {
if(length(gapsize) > 2) {
points(x[middleones],y[middleones]-gapsize[1],
lty=lty[middleones],col=col[middleones],pch=pch[middleones],...)
points(x[bigones],y[bigones] - (gapsize[1] + gapsize[3]),
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
else points(x[bigones],y[bigones]-gapsize[1],
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
else {
if(length(gapsize) > 2) {
points(x[middleones] - gapsize[1],y[middleones],
lty=lty[middleones],col=col[middleones],pch=pch[middleones],...)
points(x[bigones] - (gapsize[1] + gapsize[3]),y[bigones],
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
else points(x[bigones]-gapsize[1],y[bigones],
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
}
else {
plot(x[littleones],y[littleones],xlim=xlim,ylim=ylim,axes=FALSE,
lty=lty[littleones],col=col[littleones],pch=pch[littleones],...)
box()
if(gap.axis == "y") {
if(!is.na(xtics[1])) axis(1,at=xtics,labels=xticlab)
littletics<-which(ytics < gap[1])
if(length(gapsize) > 2) {
middletics<-which(ytics >= gap[2]+ygw & ytics <= gap[3])
bigtics<-which(ytics >= gap[4]+ygw)
show.at<-c(ytics[littletics],ytics[middletics] - gapsize[1],
ytics[bigtics]-(gapsize[1] + gapsize[3]))
show.labels<-c(yticlab[littletics],yticlab[middletics],yticlab[bigtics])
}
else {
bigtics<-which(ytics >= gap[2])
show.at<-c(ytics[littletics],ytics[bigtics] - gapsize[1])
show.labels<-c(yticlab[littletics],yticlab[bigtics])
}
if(stax) {
axis(2,at=show.at,labels=rep("",length(show.labels)))
staxlab(2,at=show.at,labels=show.labels)
}
else axis(2,at=show.at,labels=show.labels)
axis.break(2,gap[1],style="gap",bgcol=bgcol,
breakcol=breakcol,brw=brw)
if(length(gapsize) > 2) {
axis.break(2,gap[3]-gapsize[1],style="gap",bgcol=bgcol,
breakcol=breakcol,brw=brw)
points(x[middleones],y[middleones]-gapsize[1],
lty=lty[middleones],col=col[middleones],pch=pch[middleones],...)
points(x[bigones],y[bigones]-(gapsize[1]+gapsize[3]),
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
else points(x[bigones],y[bigones]-gapsize[1],
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
# x gaps need to be fixed
else {
if(!is.na(ytics[1])) axis(2,at=ytics,labels=yticlab)
littletics<-which(xtics < gap[1])
if(length(gapsize) > 2) {
middletics<-which(xtics >= gap[2] + xgw & xtics <= gap[3])
bigtics<-which(xtics > gap[4]+xgw)
show.at<-c(xtics[littletics],xtics[middletics]-gapsize[1],
xtics[bigtics]-(gapsize[1]+gapsize[3]))
show.labels<-c(xticlab[littletics],xticlab[middletics],xticlab[bigtics])
}
else {
bigtics<-which(xtics > gap[2]+xgw)
show.at<-c(xtics[littletics],xtics[bigtics]-gapsize[1])
show.labels<-c(xticlab[littletics],xticlab[bigtics])
}
if(stax) {
axis(1,at=show.at,labels=rep("",length(show.labels)))
staxlab(1,at=show.at,labels=show.labels)
}
else axis(1,at=show.at,labels=show.labels)
axis.break(1,gap[1],style="gap")
if(length(gapsize) > 2) {
axis.break(1,gap[3]-gapsize[1],style="gap")
points(x[middleones]-gapsize[1],y[middleones],
lty=lty[middleones],col=col[middleones],pch=pch[middleones],...)
points(x[bigones]-(gapsize[1]+gapsize[3]),y[bigones],
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
else points(x[bigones]-gapsize[1],y[bigones],
lty=lty[bigones],col=col[bigones],pch=pch[bigones],...)
}
}
}
plotrix/R/soil.texture.R 0000755 0001762 0000144 00000004230 14011145766 014753 0 ustar ligges users get.soil.texture<-function(use.percentages=FALSE,cnames=c("sand","silt","clay")) {
return(get.triprop(use.percentages=use.percentages, cnames=cnames))
}
soil.texture<-function(soiltexture=NULL,main="",at=seq(0.1,0.9,by=0.1),
axis.labels=c("percent sand","percent silt","percent clay"),
tick.labels=list(l=seq(10,90,by=10),r=seq(10,90,by=10),b=seq(10,90,by=10)),
show.names=TRUE,show.lines=TRUE,col.names="gray",bg.names=par("bg"),
show.grid=FALSE,col.axis="black",col.lines="gray",col.grid="gray",
lty.grid=3,show.legend=FALSE,label.points=FALSE,point.labels=NULL,
col.symbols="black",pch=par("pch"), ...) {
par(xpd=TRUE)
triax.plot(x=NULL,main=main,at=at,axis.labels=axis.labels,tick.labels=tick.labels,
col.axis=col.axis,show.grid=show.grid,col.grid=col.grid,lty.grid=lty.grid)
arrows(0.12,0.41,0.22,0.57,length=0.15)
arrows(0.78,0.57,0.88,0.41,length=0.15)
arrows(0.6,-0.1,0.38,-0.1,length=0.15)
if(show.lines) {
triax.segments<-function(h1,h3,t1,t3,col) {
segments(1-h1-h3/2,h3*sin(pi/3),1-t1-t3/2,t3*sin(pi/3),col=col)
}
# from bottom-left to up
h1 <- c(85, 70, 80, 52, 52, 50, 20, 8, 52, 45, 45, 65, 45, 20, 20)/100
h3 <- c( 0, 0, 20, 20, 7, 0, 0, 12, 20, 27, 27, 35, 40, 27, 40)/100
t1 <- c(90, 85, 52, 52, 43, 23, 8, 0, 45, 0, 45, 45, 0, 20, 0)/100
t3 <- c(10, 15, 20, 7, 7, 27, 12, 12, 27, 27, 55, 35, 40, 40, 60)/100
triax.segments(h1, h3, t1, t3, col.lines)
}
if(show.names) {
xpos <- c(0.5, 0.7, 0.7, 0.73, 0.73, 0.5, 0.275, 0.275, 0.27,
0.27, 0.25, 0.135, 0.18, 0.055, 0.49, 0.72, 0.9)
ypos <- c(0.66, 0.49, 0.44, 0.36, 0.32, 0.35, 0.43, 0.39, 0.3,
0.26, 0.13, 0.072, 0.032, 0.024, 0.18, 0.15, 0.06)*sin(pi/3)
snames <- c("clay", "silty", "clay", "silty clay", "loam",
"clay loam", "sandy", "clay", "sandy clay", "loam", "sandy loam",
"loamy", "sand", "sand", "loam", "silt loam", "silt")
boxed.labels(xpos, ypos, snames, border=FALSE, xpad=0.5)
}
par(xpd=FALSE)
# now call triax.points
if(is.null(soiltexture)) return(NULL)
soilpoints <- triax.points(soiltexture, show.legend=show.legend,
label.points=label.points, point.labels=point.labels,
col.symbols=col.symbols, pch=pch, ...)
invisible(soilpoints)
}
plotrix/R/fullaxis.R 0000755 0001762 0000144 00000001351 14011145766 014136 0 ustar ligges users fullaxis<-function(side=1,at=NULL,labels=TRUE,line=NA,pos=NA,outer=FALSE,
font=NA,lty="solid",lwd=1,lwd.ticks=lwd,col=NULL,col.ticks=NULL,
hadj=NA,padj=NA,...) {
xylim<-par("usr")
if(!is.na(pos)) xylim[c(3,1,4,2)[side]]<-pos
par(xpd=TRUE)
switch(side,
segments(xylim[1],xylim[3],xylim[2],xylim[3],col=col,lty=lty,lwd=lwd),
segments(xylim[1],xylim[3],xylim[1],xylim[4],col=col,lty=lty,lwd=lwd),
segments(xylim[1],xylim[4],xylim[2],xylim[4],col=col,lty=lty,lwd=lwd),
segments(xylim[2],xylim[3],xylim[2],xylim[4],col=col,lty=lty,lwd=lwd))
par(xpd=FALSE)
axpos<-axis(side=side,at=at,labels=labels,line=line,pos=pos,outer=outer,
font=font,lty=lty,lwd=lwd,col=col,col.ticks=col.ticks,
hadj=hadj,padj=padj,...)
invisible(axpos)
}
plotrix/R/gradient.rect.R 0000755 0001762 0000144 00000002440 14011145766 015040 0 ustar ligges users gradient.rect<-function(xleft,ybottom,xright,ytop,reds,greens,blues,
col=NULL,nslices=50,gradient="x",border=par("fg")) {
if(is.null(col)) col<-color.gradient(reds, greens, blues, nslices)
else nslices<-length(col)
nrect<-max(unlist(lapply(list(xleft,ybottom,xright,ytop),length)))
oldxpd<-par(xpd=NA)
if(nrect > 1) {
if(length(xleft) < nrect) xleft<-rep(xleft,length.out=nrect)
if(length(ybottom) < nrect) ybottom<-rep(ybottom,length.out=nrect)
if(length(xright) < nrect) xright<-rep(xright,length.out=nrect)
if(length(ytop) < nrect) ytop<-rep(ytop,length.out=nrect)
for(i in 1:nrect)
gradient.rect(xleft[i],ybottom[i],xright[i],ytop[i],
reds,greens,blues,col,nslices,gradient,border=border)
}
else {
if (gradient == "x") {
xinc <- (xright - xleft)/nslices
xlefts <- seq(xleft, xright - xinc, length = nslices)
xrights <- xlefts + xinc
rect(xlefts,ybottom,xrights,ytop,col=col,lty=0)
rect(xlefts[1],ybottom,xrights[nslices],ytop,border=border)
}
else {
yinc <- (ytop - ybottom)/nslices
ybottoms <- seq(ybottom, ytop - yinc, length = nslices)
ytops <- ybottoms + yinc
rect(xleft,ybottoms,xright,ytops,col=col,lty=0)
rect(xleft,ybottoms[1],xright,ytops[nslices],border=border)
}
}
par(oldxpd)
invisible(col)
}
plotrix/MD5 0000644 0001762 0000144 00000035332 14116113662 012272 0 ustar ligges users 5e7492402b9803b372890e5f74e8fbb6 *DESCRIPTION
51cdae9066a4386857ec0a8d0af63b4d *NAMESPACE
58303b8d4d5bee0d9108b27f43b0619e *NEWS
2c74abe5f355af8948fa9087f56959c9 *R/ablineclip.R
163140184d1f3e7c2ac7d6131086cea4 *R/add.ps.R
76f5fc2c4426b0e082293a71976151e0 *R/addtable2plot.R
e7853ceb88480a428a43d023b2d70339 *R/arctext.R
14f3f54cccc5a098bca35987446fd64c *R/axis.break.R
e8b305523ba68e063cc674adcc66f524 *R/axis.mult.R
3806c8782457aa7df7e7a658d99c6352 *R/barNest.R
86377aafb8ce5a1f37157625ff91099a *R/barlabels.R
0ef314618dff3818e8d7de8d67d09904 *R/barp.R
d465c1736455ff6e90933e076acf1d4a *R/battleship.plot.R
8741388e67ebce73432b6b45a3939630 *R/box.heresy.R
c15906170c210a77a06dbe8cb39c12fd *R/boxed.labels.R
0c9dccbeddc4b544b8ea3048b23d4812 *R/brkdn.plot.R
449d5c290943604e4b8109cd19fba0e5 *R/brkdnNest.R
4c0c6ece9594d421306f12016366fb2f *R/bumpchart.R
f140b67957e5496859ca3cd438b09824 *R/centipede.plot.R
11f91483daa47b2d17ede65741fe6863 *R/clean.args.R
19e5a990971d1e53823c784bb93ccc92 *R/clplot.R
0d3ddb4e14698d4bdd25535abbc37b37 *R/cluster.overplot.R
ebafc9dd80844c75708434b8725c9db0 *R/clustered.dotplots.R
86952a8e0eff0913d83ed57387d0db35 *R/color.gradient.R
f1dcc78b243e40ccd379fff2a1ca0590 *R/color.id.R
7c1e83994ce386af77d3da48b84e1f8d *R/color.legend.R
d4be1a4581c0ff7005c154479a57e0b7 *R/color.scale.R
07941d0c301f5cde9ca2da59e2600cdf *R/color.scale.lines.R
317ef40edd5dceb3bd59572d86b574cf *R/color2D.matplot.R
89611589962c24f0bb961fb59899a000 *R/corner.label.R
7595c8d33778f6df60d97729f4e16f3e *R/count.overplot.R
aa20dff9cb6508240f5ffe0b0f62e4d2 *R/cylindrect.R
6ddb8ce458b2848f5fe22abb58e2f608 *R/dendroPlot.R
cc7a56e526a1e52dc86969477cd5e5af *R/densityGrid.R
6ded5907b37e91f755f5c80c1bbd7b81 *R/diamondplot.R
79ebde8655300b6dd692890fe66dad22 *R/dispersion.R
260f6d56678e337a2466b63ce31e27dd *R/display.overplot.R
e9e3f23cd4216bb463bf0993f2c604d8 *R/dotplot.mtb.R
2b89a24f263115ef7c82c24bb7cb32dc *R/draw.arc.R
cd5446e359661beb91c140df02817fa0 *R/draw.circle.R
bfcbf3aff9d82db63603f4773e280e64 *R/draw.ellipse.R
1a1383ac27b34b7bfa800009969abfc0 *R/draw.radial.line.R
b41bd3e2582e27120be17f2f2f205853 *R/drawNestedBars.R
92b383d4c98800cf63c623407dfa77de *R/ehplot.R
e3fbaf25887012ffb1b0e5b94dfb796a *R/election.R
5690e7d7fc3795124df5b97a514b9305 *R/emptyspace.R
a9e4e279a0d9c08f06200c401415dd05 *R/fan.plot.R
bda3e7166adaeffc7b2d2a5686ad924f *R/feather.plot.R
dc5d9b576bb34991c44550ad090dda03 *R/floatpie.R
9d2cc070d1d3eb1c477e3374a42a036c *R/fullaxis.R
abf8099f5da1836abdb01b0a0482eb98 *R/gantt.R
f9ddfafff1203a7e636d423fba679e1e *R/gap.barplot.R
1fe9ded529bc9bc96d2c31c21cdc3cb7 *R/gap.boxplot.R
095568ff5335532c40644171ef6460e7 *R/gap.plot.R
a67d2f8d5405476e342b2f5a6bb3e681 *R/gap_barp.R
f2c451d076cbcf808802e54b1b39f1e9 *R/get.tablepos.R
6949cc16ed4e73cc7358684e3ecab02b *R/getFigCtr.R
30440670860262b4287ee6de35cc675d *R/getIntersectList.R
f62328458fae81303b94fbb7287175c6 *R/getMarginWidth.R
67d21436412022723965cff6a8c88177 *R/getYmult.R
41230526b92eb5a58df69aa54e0a6066 *R/gradient.rect.R
09764fd0be45b01ef35f7bc551a5ecf4 *R/histStack.R
527d065bfa5d50d83dbf38b2c537a753 *R/intersectDiagram.R
a4d95ff5c4b5b264fea2e37be7f912a7 *R/joyPlot.R
0c0c4a957e0acc1f78cc56f1aef4ac4b *R/kiteChart.R
d4f22f0d1204a8436c58bef182abbeb4 *R/labbePlot.R
27982a3d5d4ea2879657c1dc56c9d070 *R/ladderplot.R
03cb2fbbe0aa70b2cd946262ebfb7813 *R/ladderplot.default.R
1295c8a724a005b446ba4637a8013586 *R/legendg.R
f88facb736d50a863537818e29e9098f *R/lengthKey.R
18a4b16260b37c922a70a6c439909b59 *R/makeIntersectList.R
83032771e287d63ea164fed14d1977f1 *R/maxEmptyRect.R
2d410de223d3dc71f9e25476e6458431 *R/multhist.R
8786b0e4df7ecb704188371c62211c9f *R/multivari.R
0922537b9c49e3cc345347e46e7087b4 *R/multsymbolbox.R
96972ee73b58d77aa5c074df75d65600 *R/p2p_arrows.R
53fc688fbe92d2f624a881d24a2745a0 *R/panes.R
22fdca0307f38bda9b0a654fe308b8d6 *R/paxis3d.R
fbdb3446eaf9b5479acfa9005247dfbd *R/pie3D.R
05f32e09e4fc7dbb36c03b155cc81137 *R/placeLabels.R
b9a64d1b0d4f890dbc817c1172fec476 *R/plotCI.R
d10a37e008c5dd3d32e5701b6da1f153 *R/plotH.R
960aae874cd12958dd6dccde3558879d *R/plot_bg.R
f10e1defb3c27cbd4459f322752389f0 *R/polygon.shadow.R
0656a3a9339178d28c7c8f14208d1094 *R/pyramid.plot.R
a9ca72cae93ae7857215c3c9345424a5 *R/radial.grid.R
4a39b9cf3f827790062a28bba3dcfda4 *R/radial.pie.R
7da2b2490a8e43021f87ee106b6a369c *R/radial.plot.R
d192a9ecba891ee23933ef1083eb5658 *R/radial.plot.labels.R
f3ec3c43b07cc3f536c00da149714272 *R/radialtext.R
53ff928d38ff1c68cf2fbdf09c26f1fb *R/raw.means.plot.R
65f60a923e476ffd4fbcbdd433152231 *R/rectFill.R
da39dde9cdb82f81e5f3373588756c59 *R/rescale.R
0325ce82523cd877ba82c2d72c664ddc *R/revaxis.R
07d12fe4254d5ca97d9bc747aea667e2 *R/rm.plot2.R
e761953480126b28a14326faa3cb680c *R/ruginv.R
94f6212eb3c3dda4532094d0547cee9f *R/size_n_color.R
ff774605f2db5e411bcef2424909bc79 *R/sizeplot.R
7b85dbba61fe145be9b3e412b403444c *R/sizetree.R
de129c7ed4e840767bbc911fb5256708 *R/smoothColors.R
4aa496843da6c03ce4273d8b3b6ae9d6 *R/soil.texture.R
16ff8805beef2f4885d4c93c5bd7ff63 *R/soil.texture.uk.R
86a9d362ca31c72a7e1be15add46b3a9 *R/spread.labels.R
45b113476e355fa9117ee728b8071f2a *R/spreadout.R
2e36e418ee1b79c69ea92a2b7935855a *R/stackpoly.R
1476947622a48a0584ddc801394ebbdf *R/staircase.plot.R
92140017f521faa7596e7e42ef3fd5a6 *R/starPie.R
d9ebe081e5ceb34451fa2b37b91f8684 *R/staxlab.R
aee2eae39690917f1a489cb30122e977 *R/std.error.R
2f44a7f9539af99f2e91128142d315f0 *R/symbolbarplot.R
baa253c7a54bcde2837f305ef2b492b4 *R/symbolbox.R
03fb7639ade1f0447d3630d247adfb12 *R/tab.title.R
e9840d3ba7b9f9c60df41b8020f9c98c *R/taylor.diagram.R
c6ac650f1204191a4da58698aa063467 *R/textbox.R
9e26137c10eae9f348ce5285c869cbdc *R/thigmophobe.R
042c8a7f5be2549f791350c0fc9eb541 *R/thigmophobe.labels.R
1f986c0d9dd119a07f63bcfae6c3db9f *R/triax.R
dec059d897186f22ea6815dbd00b9f10 *R/tsxpos.R
7ce4c8fd22402437043e766914593062 *R/twoord.plot.R
580be3c65f98df81f92dff1eff5e671c *R/twoord.stackplot.R
5f66f535cd59fbe5273f85b976c294e1 *R/vectorField.R
8d276a313c22a1584301665a01b662be *R/violin_plot.R
7c9cef5ec0a813acbf2ea12f50fd4e1d *R/weighted.hist.R
481b3f85c721c582bc955c5059ba7c1e *R/windrose.R
52d0de3c89b6d90fe1e9157b0c76f291 *R/zoomInPlot.R
6c5b0047d50b0d071c9a8162c81ccb31 *data/death_reg.rda
db7ccec9c3f56f957ae404ac7eb806ab *data/l2010.rda
28da395b56d0844c2810292c955c8390 *data/soils.rda
271f59ed8376069aee632b80ba619089 *demo/00Index
7d5c62634e9c734037c6e1381b3c246e *demo/plotrix.R
b35ca73e819dbad59881960986301ef3 *inst/CITATION
18976d8d5ea793f2c57cdc0a6a09d923 *man/ablineclip.Rd
537da0d23075efb4f8a3632aa39f3901 *man/add.ps.Rd
9eee36ce9e1b11859d11f4cd0f713f96 *man/addtable2plot.Rd
f38bcb4f376f4e73babaa106e7880804 *man/arctext.Rd
a71910a0f86e93cf206486763a59aed8 *man/axis.break.Rd
282b2f8fcd742e3d6a60ab081aaa405b *man/axis.mult.Rd
4a254023ffa5135515e72a183fd8741a *man/barNest.Rd
a5bcd07b2d0f85bbd20a4e0cc2ccf29b *man/barlabels.Rd
309ef3fa24d49f8dbe43eb738b99cf88 *man/barp.Rd
be8e61e3b745fbc214f0b4447de98aca *man/battleship.plot.Rd
898f3abab9664c2f87d1a527f622e6ba *man/bin.wind.records.Rd
95aa3fa95caa2363648ac7fe3c0c370d *man/binciW.Rd
399bd24635823861f7157e5dd758d19a *man/binciWl.Rd
ce6a7a21766880d71efe042eb039e7f6 *man/binciWu.Rd
274cddbcaaed3b7ec19d93d9e2376223 *man/box.heresy.Rd
26fbfecc3ec5ac9fe68f2655ad732e41 *man/boxed.labels.Rd
22d97f8258875c002732fcdf18a2e020 *man/brkdn.plot.Rd
fa74a70c6281052ff09a42184378d51e *man/brkdnNest.Rd
43a551455c8102aeecb4145ec6662130 *man/bumpchart.Rd
fdd959e735ce69d626bc683c7142a487 *man/categoryReshape.Rd
e57177261b61c4ef3b8caf59dbda3091 *man/centipede.plot.Rd
d6019ca90bd3aaaff4e63d9b55aff24c *man/clean.args.Rd
2901a3ae51935abd7510121796844dc1 *man/clock24.plot.Rd
dc4c200cb331f0490d5ce7ee0975534d *man/clplot.Rd
d8ebaeda4ed4a0af0ee365fc75ddd28a *man/cluster.overplot.Rd
a44a53d6840ae4f18cec592a2c8755d7 *man/clustered.dotplots.Rd
6322f0d88a0098ecf7de26b6add180e4 *man/color.axis.Rd
4108e162137a9083bd347763abbd63d7 *man/color.gradient.Rd
5f2c9fa598ebecc3e78595a2c8d63252 *man/color.id.Rd
e11a8f667843c9ee5697b3604722dbf1 *man/color.legend.Rd
5609313a025ff5495c8ef629b4596088 *man/color.scale.Rd
45e516c607c3f1d3b7766595015d514c *man/color.scale.lines.Rd
87614cfd26593eb6242395551f52a5a6 *man/color2D.matplot.Rd
51cd6dbe551abddadcf23f297b3fcef9 *man/corner.label.Rd
35453606f45c916c9b5f77020c3c3b0c *man/count.overplot.Rd
b6bc308f4d4d62c4302afddb22666411 *man/cylindrect.Rd
403fec7cba6c01095a718a8503001bac *man/death_reg.Rd
afb5f5ce1e6dbc78e8843df397f2f10c *man/dendroPlot.Rd
653017e6f7a28341009a486288a73188 *man/densityGrid.Rd
470583ce423fd9c05502a784d10114eb *man/diamondplot.Rd
1780eb1f4a06114e83870dd1de250ce8 *man/dispersion.Rd
316cbd9616959d741b2ecbe6ec3254cd *man/do.first.Rd
4f25fe768fe00195d5ac270098c261f5 *man/dotplot.mtb.Rd
cb68dd72282e0a252f1689d786a10371 *man/draw.arc.Rd
385b175c50e92fe72d33111d350e702f *man/draw.circle.Rd
4a4c1b00cab07fbe4a3d426c9e99ed6f *man/draw.ellipse.Rd
84e9daf9df6dc02632d28aad82fe552e *man/draw.radial.line.Rd
c771ff20c909ba6d894c1dd73499b079 *man/draw.tilted.sector.Rd
5f708405095411f3d239bd13c6e37a4e *man/drawNestedBars.Rd
e0cf4b49c5d11ec218ef091e3766443c *man/drawSectorAnnulus.Rd
1a84743b049644f50069d520be4f7fe6 *man/ehplot.Rd
3d1a40efc7bc84da1c6d4b59b7161c4b *man/election.Rd
4eb5b9648e8de073082c4d98fbb108af *man/emptyspace.Rd
b55609273a2b9957e2c4f963392bb157 *man/fan.plot.Rd
fffabb21a837f2c1263dc71d2911f3d0 *man/feather.plot.Rd
7fc047f882280b8673a96f6d21b9a1d9 *man/fill.corner.Rd
65bb7a717f1b836d2357ece04281236c *man/find_max_cell.Rd
a9bb487aa05d672d528cf05c823d4d12 *man/floating.pie.Rd
ef0018a2314c3b5bf4d0e953ae036aed *man/fullaxis.Rd
0f87c03e28f4f3528dd031077897cf98 *man/gantt.chart.Rd
4ac19f9bcfde71dd07c1326d6750b1ed *man/gap.barplot.Rd
a1ed7586441ee61bd6d9ecf9ffd670d6 *man/gap.boxplot.Rd
32e58044c651a2949554e2ca6a8a8e5f *man/gap.plot.Rd
21c964d611b993d74a9b7aa5142d9af0 *man/gap_barp.Rd
2bfcd82c9e1bc208fade58833094861e *man/get.breaks.Rd
df2bdbf654df6eab3ee5e96f846efc03 *man/get.gantt.info.Rd
da679d8d83c5d75989816ea3f652e46f *man/get.segs.Rd
78207c9f46ee81fd350f075caf163c7c *man/get.soil.texture.Rd
7c308ff4259d4b2e6df08295a3ebeb31 *man/get.tablepos.Rd
b38bf1ec364fc7e0d352d23949ff09d8 *man/get.triprop.Rd
59ce154c27e79c8655eb15c56abdb8fe *man/getFigCtr.Rd
1093b6fc68dc03a6ec675766b3b240a6 *man/getIntersectList.Rd
66e9bac85163b66dbe998ef0d6e23410 *man/getMarginWidth.Rd
254cdccb0ea6f62f3c192a1f36ec7b4d *man/getYmult.Rd
81b41e59e8fdb64a7819ee5e5a1bad56 *man/get_axispos3d.Rd
165ea94083e1eaf7285da55db8094314 *man/gradient.rect.Rd
722a32a1697eac6a2d3d1b656c9e91a1 *man/hexagon.Rd
22245bc76aae5426664addcec8114c43 *man/histStack.Rd
a63853e93a6fbab6cf1ea8b7c2e9e0c9 *man/intersectDiagram.Rd
970087f83b357355eb675516f4689bfe *man/jiggle.Rd
8cf14dcef1f2178b39c1464d4c455161 *man/joyPlot.Rd
055fb77f6c128cd174b0e3620ae82e8e *man/kiteChart.Rd
18ea8892a9db4c0047cfc2359f671e0c *man/l2010.Rd
47d8e24c27f66b5d9bb08cec09bcee56 *man/labbePlot.Rd
ea06b6e8b663a57af433a17c15721e2f *man/ladderplot.Rd
89aa2add323d7ed77ee1f7c8014f20c7 *man/legendg.Rd
1087aef8002dcf7dd3c93309aa1e37fc *man/lengthKey.Rd
c9313f6dc12596114e3b8a22ce0b9f12 *man/makeDensityMatrix.Rd
c0b8e0b3c7e76df5a47dbc4d918d82dc *man/makeIntersectList.Rd
4bf0a63a5ee0f446c2dd210ebd97b726 *man/maxEmptyRect.Rd
4bb726d76edd975db9258cd700783dcc *man/mtext3d.Rd
c149bcc2fe8d19017a0502b8ef9fe0c4 *man/multhist.Rd
b973f5822d921c57634d641ecd5c3f26 *man/multivari.Rd
a6b1e2596340a535c74848aeffe98833 *man/multsymbolbox.Rd
41c1c83e66a33d35bb0f48d9dfd68909 *man/oz.windrose.Rd
00585c01256159f892de1181dd9f63f3 *man/oz.windrose.legend.Rd
6858a19ebe31e922e871d0a66ef5be43 *man/p2p_arrows.Rd
f5f9a3f8fc633f528b69502756b032fe *man/panes.Rd
e64d53c83bcdabd46565c0ebee38e23c *man/pasteCols.Rd
df16d5a7e051f52e37eb2624bed0abf2 *man/paxis3d.Rd
024a5c644d2982a431cebaa10fd2131f *man/perspx.Rd
96a09cba00798fcd3d544790e4b992ec *man/pie.labels.Rd
6611561a873f31307e7de20c63a304f7 *man/pie3D.Rd
9209e3496d57207f40745b435e473b03 *man/pie3D.labels.Rd
34eaf73d08569f68d5f54156b3b907cf *man/placeLabels.Rd
94da9e98fdf1f64739b188fea1f021f6 *man/plotCI.Rd
d537e859f11754e2ab779d75c82a0086 *man/plotH.Rd
d0be8d8872d21c55c387ed117d60bc92 *man/plot_bg.Rd
0d66618b9edc5d3b02b7037a634bf0cc *man/plotrix-package.Rd
f99459c22b2d5267043f04a863105042 *man/polar.plot.Rd
aacd4acbdc1275ecff45c6d962ae8f16 *man/polygon.shadow.Rd
8d1dc46509d56126301ed969bff3ed8c *man/print.brklist.Rd
3624e09ffd23b05f6681cc1c31734345 *man/propbrk.Rd
d3979b4cb2e49006ebd6bc1e2c795fb9 *man/psegments3d.Rd
a239386f59c013ebc0e4bf9fcabc5747 *man/ptext3d.Rd
dddf2ba43c782b71e5a155e6a4b2abe5 *man/pyramid.plot.Rd
d0f65eab9235a7dc9694916771a796fd *man/radial.grid.Rd
e1ecf218a7dd9d4b5bec2a491a079982 *man/radial.pie.Rd
74aeeb71451d6b5d53df4f4959d576e2 *man/radial.plot.Rd
390d79e90c403eb71c00be6f2d84047c *man/radial.plot.labels.Rd
9e52803106c4336f54b18549a02a99d2 *man/radialtext.Rd
d442e353076ad725947c6e2e6057fa98 *man/raw.means.plot.Rd
12483f6f1bca2cc5501598e3e4a98aed *man/rectFill.Rd
c4f2c015fcd5a98581ef7859a1640e5a *man/rescale.Rd
806b61300d1880bdd26a85011d845714 *man/revaxis.Rd
e707694b2762db46d4e938f3383b5577 *man/ruginv.Rd
263fe882f280cc6bb721db6f9abf5e10 *man/seats.Rd
44fac82cd667819d0f167299987c4fcf *man/size_n_color.Rd
f2586a13028c3884bdc4335610c67dc9 *man/sizeplot.Rd
5e3eaf86657a5d098e9c9c53e783d689 *man/sizetree.Rd
554e180d9da267bedc3ad04b2bd6f4aa *man/sliceArray.Rd
1b6f61faec620b2a1cc2b4c1b95fcc7e *man/smoothColors.Rd
7ac386e8429fc20bed646d98078e267e *man/soil.texture.Rd
56b0e186a2d31d3f9c4f5a38f54540df *man/soil.texture.uk.Rd
1538a56e8001fbdac5bc6fe59989cb75 *man/soils.Rd
94621600224164995f082b46963b8f87 *man/spread.labels.Rd
68ecac1afb03f4f889768018295f8a2c *man/spreadout.Rd
67b5e4985491c2c0d6613aac7f25fe1c *man/stackpoly.Rd
c2ce7111858d31a7b5f06edd041ef529 *man/staircase.plot.Rd
fbcccb22f79e1e9e7240425bb4eff6d7 *man/staircasePlot.Rd
13f237779bc123645ee131e980706d31 *man/starPie.Rd
f760e55d505d833f1ea192120307b7f0 *man/staxlab.Rd
40286c6064e6b9e29ba37f06058b89df *man/std.error.Rd
38d5ea8f92b0d3075828ef204d808eaf *man/sumbrk.Rd
ef9a85ac60b082897b7a8c3a8c9892ee *man/symbolbarplot.Rd
ae8f69cda8160327316c915a992151c9 *man/symbolbox.Rd
d9f79a0e522fcb9a4d1af0873723a412 *man/tab.title.Rd
76e9e7908a121e2282b6228d3fad3b1e *man/taylor.diagram.Rd
78e9845825dfde81846bdca59142da45 *man/textbox.Rd
d3bceb4fb894f93c0c0d707927aa98e0 *man/thigmophobe.Rd
4f7a77bbf7f29248928acc1e22ab25a3 *man/thigmophobe.labels.Rd
ac5071d4a906c8d08c62d24c1059d548 *man/triax.abline.Rd
5fc757905ff2fb69baab63abdba3d364 *man/triax.fill.Rd
ef26303ff7d7fca80a4e6aa6a4faface *man/triax.frame.Rd
478c52edbe8942350a7c74977f0e7668 *man/triax.plot.Rd
c3cb06c35bef99ec1f66e7fe577a9ddf *man/triax.points.Rd
d0def030f355745d885dcabf7e1beb2e *man/tsxpos.Rd
9ce1683507645a9e36f685be2b9172e9 *man/twoord.plot.Rd
4b0b895d4f207d31f039876eee86c956 *man/twoord.stackplot.Rd
517c4cd06972f8ccde88ccd063e40dd1 *man/valid.n.Rd
fec04eee273289a8f3cc6c1ab2c74741 *man/vectorField.Rd
b64ff5cb80554577b73c3c8126d84b35 *man/violin_plot.Rd
4210a9a4bb82b64728a571ab272408c9 *man/weighted.hist.Rd
2ac8767af5192740723f42558d4486e9 *man/zoomInPlot.Rd
plotrix/inst/ 0000755 0001762 0000144 00000000000 14011145766 012735 5 ustar ligges users plotrix/inst/CITATION 0000755 0001762 0000144 00000000577 14011145766 014106 0 ustar ligges users citHeader("To cite package 'plotrix' in publications use:")
citEntry(entry="Article",
year = 2006,
title = "Plotrix: a package in the red light district of R",
journal = "R-News",
volume = "6",
number = "4",
pages = "8-12",
author = personList(as.person("Lemon J")),
textVersion = "Lemon, J. (2006) Plotrix: a package in the red light
district of R. R-News, 6(4): 8-12."
)