On 02/14/2010 01:27 AM, Orvalho Augusto wrote:
I am using pyramid.plot() from the plotrix package.
...
The problem is (1) I do not want plot agelabels on the center and (2)
I want plot different labels for each pair of the bars (one label for
masculine and the other feminine).
The data represent the 10 most frequent cancer in a group of individuals.
Bueno troglodita,
You have discovered a deficiency in pyramid.plot, and for that you get
an answer to your question and brand new source code!
source("pyramid.plot.R")
after loading the plotrix package. Use it quickly, for it will be in the
next version of plotrix and then everyone (todo el mundo, hombre!) will
be using it.
Jim
# it must be wider than the default to accommodate the long labels
x11(width=10)
par(mar=pyramid.plot(dados$masfr,dados$femfr,
laxlab=c(0,10,20,30,40),raxlab=c(0,10,20,30,40),
main="Primeiras 10 cancros mais frequentes por sexo",
top.labels=c("Masculino", "Tipo de cancro", "Feminino"),
labels=dados[,c("maslab","femlab")],
xycol=rep("#8888ff",10),xxcol=rep("#ff88ff",10), gap=25))
pyramid.plot<-function(xy,xx,labels=NA,top.labels=c("Male","Age","Female"),
main="",laxlab=NULL,raxlab=NULL,unit="%",xycol,xxcol,gap=1,
labelcex=1,mark.cat=NA,add=FALSE) {
if(any(c(xy,xx)<0)) stop("Negative quantities not allowed")
xydim<-dim(xy)
if(length(labels)==1) labels<-1:xydim[1]
ncats<-ifelse(is.null(dim(labels)),length(labels),length(labels[,1]))
if(is.null(xydim)) {
if(length(xy) != ncats || length(xx) != ncats)
stop("xy, xx and labels must all be the same length")
halfwidth<-ceiling(max(c(xy,xx)))+gap
}
else {
if(length(xy[,1]) != ncats || length(xx[,1]) != ncats)
stop("xy, xx and labels must all be the same length")
halfwidth<-ceiling(max(c(rowSums(xy),rowSums(xx))))+gap
}
oldmar<-par("mar")
if(!add) {
par(mar=c(4,2,4,2))
plot(0,xlim=c(-halfwidth,halfwidth),ylim=c(0,ncats+1),
type="n",axes=FALSE,xlab="",ylab="",xaxs="i",yaxs="i",main=main)
if(is.null(laxlab)) {
laxlab<-seq(halfwidth-gap,0,by=-1)
axis(1,at=-halfwidth:-gap,labels=laxlab)
}
else axis(1,at=-(laxlab+gap),labels=laxlab)
if(is.null(raxlab)) {
raxlab<-0:(halfwidth-gap)
axis(1,at=gap:halfwidth,labels=raxlab)
}
else axis(1,at=raxlab+gap,labels=raxlab)
axis(2,at=1:ncats,labels=rep("",ncats),pos=gap,tcl=-0.25)
axis(4,at=1:ncats,labels=rep("",ncats),pos=-gap,tcl=-0.25)
if(!is.na(mark.cat)) boxed.labels(0,mark.cat,labels[mark.cat])
if(is.null(dim(labels))) text(0,1:ncats,labels,cex=labelcex)
else {
text(-gap*0.9,1:ncats,labels[,1],cex=labelcex,adj=0)
text(gap*0.9,1:ncats,labels[,2],cex=labelcex,adj=1)
}
mtext(top.labels,3,0,at=c(-halfwidth/2,0,halfwidth/2),
adj=0.5,cex=labelcex)
mtext(c(unit,unit),1,2,at=c(-halfwidth/2,halfwidth/2))
}
if(is.null(xydim)) {
if(missing(xycol)) xycol<-rainbow(ncats)
if(missing(xxcol)) xxcol<-rainbow(ncats)
rect(-(xy+gap),1:ncats-0.4,rep(-gap,ncats),1:ncats+0.4,col=xycol)
rect(rep(gap,ncats),1:ncats-0.4,(xx+gap),1:ncats+0.4,col=xxcol)
}
else {
if(missing(xycol)) xycol<-rainbow(xydim[2])
if(missing(xxcol)) xxcol<-rainbow(xydim[2])
xystart<-xxstart<-rep(gap,ncats)
for(i in 1:xydim[2]) {
xycolor<-rep(xycol[i],ncats)
xxcolor<-rep(xxcol[i],ncats)
rect(-(xy[,i]+xystart),1:ncats-0.4,-xystart,1:ncats+0.4,
col=xycolor)
rect(xxstart,1:ncats-0.4,xx[,i]+xxstart,1:ncats+0.4,
col=xxcolor)
xystart<-xy[,i]+xystart
xxstart<-xx[,i]+xxstart
}
}
return(oldmar)
}
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
