File: gap_barp.R

package info (click to toggle)
r-cran-plotrix 3.8-1-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 1,580 kB
  • sloc: makefile: 6
file content (45 lines) | stat: -rw-r--r-- 1,734 bytes parent folder | download | duplicates (3)
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
gap_barp<-function (height,gap,width=0.4,names.arg=names(height),
 col=NULL,main="",xlab="",ylab="",xlim=NULL,ylim=NULL,x=NULL,
 height.at=pretty(height),height.lab=NULL,...) {
 
 if (missing(height)) stop("height values required")
 hdim<-dim(height)
 if(is.data.frame(height)) height<-as.matrix(height)
 if(is.null(height.lab)) height.lab<-height.at
 if(missing(gap)) stop("gap must be specified")
 if(gap[1] > gap[2]) {
  temp<-gap[2]
  gap[2]<-gap[1]
  gap[2]<-temp
 }
 if (length(ylab) == 0) ylab <- deparse(substitute(height))
 if (is.null(col)) {
  col<-color.gradient(c(0,1),c(0,1,0),c(1,0),length(height))
  if(!is.null(dim(height))) col<-matrix(col,ncol=hdim[2])
 }
 else if(length(col) < length(height)) rep(col,length.out=length(height))
 if(mean(gap) < 0) to_gap<-which(height < min(gap))
 else to_gap<-which(height > max(gap))
 if(length(to_gap) == 0) stop("no values outside gap")
 if(any(height > gap[1] & height < gap[2])) {
  warning("some heights within gap")
  height[height > gap[1] & height < gap[2]]<-gap[2-(mean(gap) < 0)]
 }
 if(is.null(height.lab)) height.lab<-height.at
 if(mean(gap) < 0) {
  height[to_gap]<-height[to_gap] + diff(gap)
  height.at[height.at < gap[1]]<-height.at[height.at < gap[1]] + diff(gap)
 }
 else {
  height[to_gap]<-height[to_gap] - diff(gap)
  height.at[height.at > gap[2]]<-height.at[height.at > gap[2]] - diff(gap)
 }
 if(is.null(hdim)) colnam<-names(height)
 else colnam<-colnames(height)
 barpinfo<-barp(height=height,names.arg=colnam,col=col,
  main=main,xlab=xlab,ylab=ylab,
  height.at=height.at,height.lab=height.lab,
  xlim=xlim,ylim=ylim,x=x,...)
 axis.break(2,gap[ifelse(mean(gap) > 0,1,2)],style="gap")
 invisible(barpinfo)
}