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

From: Jim Lemon <jim_at_bitwrit.com.au>
Date: Sun, 16 Dec 2007 20:29:40 +1100

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



R-help_at_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. Received on Sun 16 Dec 2007 - 09:32:17 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Sun 16 Dec 2007 - 14:30:18 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.