Re: [R] Is there way to multiple plots on gap.plot?

From: Jim Lemon <jim_at_bitwrit.com.au>
Date: Tue, 29 Jul 2008 19:01:14 +1000

On Mon, 2008-07-28 at 12:15 -0700, Arthur Roberts wrote:

> Hi, all,
> 
> Does anyone now of a way to put multiple plots on gap.plot?
> 
> Much appreciated,

Hi Art,
You must have read my mind. In solving the problem you had with gap.plot, I considered including an "add" argument that would allow the user to add values to an existing plot. The bad news is that I decided against it. As the examples show, you can plot several series of data simultaneously with not very much trouble. However, if you can convince me that "add" is a good idea, I might do it. Right now, though, I would appreciate your testing of the new gap.plot function below.

Jim

gap.plot<-function(x,y,gap,gap.axis="y",bgcol="white",breakcol="black",  brw=0.02,xlim,ylim,xticlab,xtics=NA,yticlab,ytics=NA,lty=rep(1,length(x)),  col=rep(par("col"),length(x)),pch=rep(1,length(x)),...) {

 if(missing(y) && !missing(x)) {
  y<-x
  x<-1:length(y)
 }
 if(missing(gap)) stop("gap must be specified")  gapsize<-diff(gap)
 figxy <- par("usr")
 xaxl<-par("xlog")
 yaxl<-par("ylog")
 xgw<-(figxy[2]-figxy[1])*brw
 ygw<-(figxy[4]-figxy[3])*brw

 if(missing(xtics)) xtics<-pretty(x)
 if(missing(ytics)) 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(gapsize) > 2) {
   middleones<-which(y >= gap[2] & y < gap[3])    bigones<-which(y >= gap[4])
   lostones<-sum(c(y > gap[1] & y < gap[2], y > gap[3] & y < gap[4]))    if(missing(ylim)) ylim<-c(min(y),ygw*2 +max(y)-(gapsize[1]+gapsize[3]))

   else ylim[2]<-ygw*2+ylim[2]-(gapsize[1]+gapsize[3])
}

  else {
   middleones<-NA
   bigones<-which(y >= gap[2])
   lostones<-sum(y > gap[1] & y < gap[2])    if(missing(ylim)) ylim<-c(min(y),max(y)-gapsize[1])    else ylim[2]<-ygw+ylim[2]-gapsize[1]
}

  if(lostones) warning("some values of y will not be displayed")   if(missing(xlim)) xlim<-range(x)
 }
 else {
  littleones<-which(x < gap[1])
  if(length(gapsize) > 2) {
   middleones<-which(x >= gap[2] & x < gap[3])    bigones<-which(x >= gap[4])
   lostones<-sum(c(x > gap[1] & x < gap[2], x > gap[3] & x < gap[4]))    if(missing(xlim)) xlim<-c(min(x),xgw*2 +max(x)-(gapsize[1]+gapsize[3]))

   else xlim[2]<-xgw*2+xlim[2]-(gapsize[1]+gapsize[3])
}

  else {
   middleones<-NA
   bigones<-which(x >= gap[2])
   lostones<-sum(x > gap[1] & x < gap[2])    if(missing(xlim)) xlim<-c(min(x),max(x)-gapsize[1])    else xlim[2]<-xgw+xlim[2]-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))
 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] & ytics <= gap[3])    bigtics<-which(ytics >= gap[4])
   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(ytics[littletics],yticlab[bigtics])
}

  axis(2,at=show.at,labels=show.labels)
  axis.break(2,gap
  [1]-ygw,style="gap",bgcol=bgcol,breakcol=breakcol,brw=brw)   if(length(gapsize) > 2) {
   axis.break(2,gap[3]-(gapsize[1]+ygw),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],...)  }
 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] & xtics <= gap[3])    bigtics<-which(xtics >= gap[4])
   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])
   show.at<-c(xtics[littletics],xtics[bigtics]-gapsize[1])    show.labels<-c(xticlab[littletics],xticlab[bigtics])
}

  axis(1,at=show.at,labels=show.labels)
  axis.break(1,gap[1]-xgw,style="gap")
  if(length(gapsize) > 2) {
   axis.break(1,gap[3]-(gapsize[1]+xgw),style="gap")    points(xgw+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],...)  }
}

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 Tue 29 Jul 2008 - 08:59:34 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 Tue 29 Jul 2008 - 12:32:51 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.

list of date sections of archive