[R] Changing the origin in polar.plot in plotrix package

Jim Lemon jim at bitwrit.com.au
Sun Dec 16 10:29:40 CET 2007


John Beamer wrote:
> I am trying to draw a polar plot, which is easy enough to do in the
> plotrix package through the polar.plot function.
> 
> However I would like to change the origin of the length vector. For
> instance all my length values are between 75 and 85, so instead of
> having the origin as 0 (the default) I'd like it to be, say, 50.
> 
> Is there any way do to this in the polar.plot function, or if not is
> there an additional package that will accomplish this.
> 
> I am running R 2.5 and the latest version of plotrix.
> 
Hi John,
The short answer is no.

The long answer is:

radial.plot<-function(lengths,radial.pos=NULL,
  labels=NA,label.pos=NULL,start=0,clockwise=FALSE,
  rp.type="r",label.prop=1.1,main="",xlab="",ylab="",
  line.col=par("fg"),mar=c(2,2,3,2),show.grid=TRUE,
  show.radial.grid=TRUE,grid.col="gray",
  grid.bg="transparent",grid.left=FALSE,
  point.symbols=NULL,point.col=NULL,
  show.centroid=FALSE,radial.lim=NULL,...) {

  if(is.null(radial.lim)) radial.lim<-range(lengths)
  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))
   radial.pos<-seq(0,pi*(2-2/npoints),length=npoints)
  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(clockwise) radial.pos<--radial.pos
  if(start) radial.pos<-radial.pos+start
  if(show.grid) {
   grid.pos<-pretty(radial.lim)
   if(grid.pos[1] <= radial.lim[1])
    grid.pos<-grid.pos[-1]
   maxlength<-max(grid.pos-radial.lim[1])
   angles<-seq(0,1.96*pi,by=0.04*pi)
  }
  else {
   grid.pos<-NA
   maxlength<-diff(radial.lim)
  }
  oldpar<-par("xpd","mar","pty")
  par(mar=mar,pty="s")
  plot(c(-maxlength,maxlength),c(-maxlength,maxlength),
   type="n",axes=FALSE,
   main=main,xlab=xlab,ylab=ylab)
  par(xpd=TRUE)
  if(length(line.col) < nsets) line.col<-1:nsets
  rp.type<-unlist(strsplit(rp.type,""))
  if(match("s",rp.type,0)) {
   if(is.null(point.symbols)) point.symbols<-1:nsets
   if(length(point.symbols)<nsets)
    point.symbols<-rep(point.symbols,length.out=nsets)
   if(is.null(point.col)) point.col<-1:nsets
   if(length(point.col)<nsets)
    point.col<-rep(point.col,length.out=nsets)
  }
  # split up rp.type if there is a combination of displays
  for(i in 1:nsets) {
   # 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",rp.type,0))
    segments(0,0,xpos,ypos,col=line.col[i],...)
   if(match("p",rp.type,0))
    polygon(xpos,ypos,border=line.col[i],col=NA,...)
   if(match("s",rp.type,0))
    points(xpos,ypos,pch=point.symbols[i],
     col=point.col[i],...)
   if(show.centroid)
    points(mean(xpos),mean(ypos),col=point.col[i],
     pch=point.symbols[i],cex=2,...)
  }
  if(missing(labels)) {
   label.pos<-seq(0,1.8*pi,length=9)
   labels<-as.character(round(label.pos,2))
  }
  if(clockwise) label.pos<--label.pos
  if(start) label.pos<-label.pos+start
  xpos<-cos(label.pos)*maxlength
  ypos<-sin(label.pos)*maxlength
  if(show.radial.grid) segments(0,0,xpos,ypos,col=grid.col)
  xpos<-cos(label.pos)*maxlength*label.prop
  ypos<-sin(label.pos)*maxlength*label.prop
  boxed.labels(xpos,ypos,labels,ypad=0.7,border=FALSE)
  if(show.grid) {
   print(grid.pos)
   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)
   }
   ypos<-rep(-maxlength/15,length(grid.pos))
   boxed.labels(grid.pos-radial.lim[1],ypos,
    as.character(grid.pos),border=FALSE)
  }
  par(oldpar)
}

But you will have to test it, and I would appreciate knowing if anything 
breaks. Thanks.

Jim



More information about the R-help mailing list