On 01/13/2010 01:50 AM, Primoz PETERLIN wrote:> Hello everybody,
>
> Is it possible to coax legend() into displaying more than one simbol per
> line in legend? I have a graph like the one attached to this mail; I would
> like to reorganize the legend in such a way that the duplicate text would
be
> omitted, i.e., the first line would read<square>
<triangledown> "increasing
> frequency" and the second one would read<circle>
<triangleup> "decreasing
> frequency". Before resorting to box() and text() I would like to check
> whether some clever method already exists that would solve my problem. :)
>
Hi Primoz,
This request has been made before on the list, so I suppose it's time to
get something together. Below is a first cut on a function to do this.
If the user sends a list as the fill= argument, each one of the legend
commands can have a few rectangles before it in different colors. The
length of the fill= argument should be the same as the length of the
legend= argument. If a list is passed as the pch= argument, the same
thing happens with points. It is probably best to pass a corresponding
list to the col= argument if the user wants different colored points.
"legendg" stands for legend(grouped).
legendg<-function(x,y=NULL,legend,fill=NULL,col=par("col"),
border="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,
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(!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=1,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)) {
rectheight<-strheight("Q")
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]])
}
}
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
for(nel in 1:length(pch)) {
midspace<-(legend.info$rect$left+legend.info$text$x[nel])/2
npch<-length(pch[[nel]])
pchwidth<-strwidth("O")
xpos<-cumsum(c(midspace-npch*0.5*pchwidth,rep(pchwidth,npch-1)))
ypos<-rep(legend.info$text$y[nel],npch)
points(xpos,ypos,pch=pch[[nel]],col=mycol[[nel]])
}
}
if(!missing(xpd)) par(xpd=oldxpd)
invisible(legend.info)
}
legendg(locator(1),c("one","two","three"),fill=list(2:3,3:5,6:7))
legendg(locator(1),c("one","two","three"),pch=list(1:2,3:5,6:7),
col=list(2:3,3:5,6:7))
Give it a whacking folks and I'll put the function into the next version
of plotrix if it survives. Also send any requests for features that I
have neglected.
Jim