File: gap.plot.R

package info (click to toggle)
r-cran-plotrix 3.2-6-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,136 kB
  • sloc: makefile: 3
file content (157 lines) | stat: -rwxr-xr-x 5,792 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
# Try to rewrite this for an arbitrary number of gaps

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)),add=FALSE,...) {

 if(missing(y) && !missing(x)) {
  y<-x
  x<-1:length(y)
 }
 if(missing(gap)) stop("gap must be specified")
 gapsize<-diff(gap)
 xaxl<-par("xlog")
 yaxl<-par("ylog")
 if(missing(ylim)) {
  if(gap.axis == "y") {
   if(length(gap) > 3) ylim<-c(min(y),max(y) - (gapsize[1] + gapsize[3]))
   else ylim<-c(min(y),max(y)-gapsize[1])
   if(missing(xlim)) xlim<-range(x)
  }
 }
 if(missing(xlim)) {
  if(gap.axis == "x") {
   if(length(gap) > 3) xlim<-c(min(x),max(x) - (gapsize[1] + gapsize[3]))
   else xlim<-c(min(x),max(x)-gapsize[1])
   if(missing(ylim)) ylim<-range(y)
  }
 }
 rangexy <- c(range(xlim),range(ylim))
 xgw<-(rangexy[2]-rangexy[1])*brw
 ygw<-(rangexy[4]-rangexy[3])*brw
 if(is.na(xtics[1])) xtics<-pretty(x)
 if(is.na(ytics[1])) 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(gap) > 3) {
   middleones<-which(y >= gap[2] + ygw & y < gap[3])
   bigones<-which(y >= gap[4] + ygw)
   lostones<-sum(c(y > gap[1] & y < gap[2] + ygw,y > gap[3] & y < gap[4] + ygw))
  }
  else {
   middleones<-NA
   bigones<-which(y >= gap[2] + ygw)
   lostones<-sum(y > gap[1] & y < gap[2] + ygw)
  }
  if(lostones) warning("some values of y will not be displayed")
 }
 else {
  littleones<-which(x < gap[1])
  if(length(gap) > 3) {
   middleones<-which(x >= gap[2] + xgw & x < gap[3])
   bigones<-which(x >= gap[4] + xgw)
   lostones<-sum(c(x > gap[1] & x < gap[2] + xgw,x > gap[3] & x < gap[4] + xgw))
   if(missing(xlim)) xlim<-c(min(x),max(x) - (gapsize[1] + gapsize[3]))
  }
  else {
   middleones<-NA
   bigones<-which(x >= gap[2])
   lostones<-sum(x > gap[1] & x < gap[2] + xgw)
   if(missing(xlim)) xlim<-c(min(x),max(x) - 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))
 if(add) {
  points(x[littleones],y[littleones],lty=lty[littleones],
   col=col[littleones],pch=pch[littleones],...)
  if(gap.axis == "y") {
   if(length(gapsize) > 2) {
    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(length(gapsize) > 2) {
    points(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],...)
  }
 }
 else {
  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],style="gap",bgcol=bgcol,
    breakcol=breakcol,brw=brw)
   if(length(gapsize) > 2) {
    axis.break(2,gap[3]-gapsize[1],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],...)
  }
  # x gaps need to be fixed
  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],style="gap")
   if(length(gapsize) > 2) {
    axis.break(1,gap[3]-gapsize[1],style="gap")
    points(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],...)
  }
 }
}