R/colorbar.R

In kkholst/neurocdf: Various utilities for handling neuroimaging data

##' Add color-bar to plot
##'
##' @title Add color-bar to plot
##' @param clut Color look-up table
##' @param x.range x range
##' @param y.range y range
##' @param values label values
##' @param digits number of digits
##' @param label.offset label offset
##' @param srt rotation of labels
##' @param cex text size
##' @param border border of color bar rectangles
##' @param direction horizontal or vertical color bars
##' @param ... additional low level arguments (i.e. parsed to \code{text})
##' @author Klaus K. Holst
##' @export
##' @examples
##' \dontrun{
##' plot(x,roi=R,mm=-18,range=5)
##' colorbar(clut <- lava:::Col(rev(rainbow(11,start=0,end=0.69)),0.5),x=c(-40,40),y.range=c(84,90),values=c(-5:5))
##' 
##' colorbar(clut <- lava:::Col(rev(rainbow(11,start=0,end=0.69)),0.5),x=c(-10,10),y.range=c(-100,50),values=c(-5:5),direction="vertical",border=1)
##' }
colorbar <- function(clut=lava:::Col(rev(rainbow(11,start=0,end=0.69)),0.5),
                     x.range=c(-.5,.5),y.range=c(-.1,.1),
                     values=seq(clut),digits=2,label.offset,srt=45,
                     cex=0.5,border=NA,
                     direction=c("horizontal","vertical"),...) {
  nlut <- length(clut)
  X <- length(agrep(tolower(direction[1]),"horizontal"))>0
  scale <- ifelse(X,diff(x.range),diff(y.range))/nlut
  barsize <- ifelse(X,diff(y.range),diff(x.range))  
  if (missing(label.offset)) label.offset <- barsize/3
  delta <- ifelse(X,x.range[1],y.range[1])
  if (!is.null(values)) dM <- diff(range(values))/(nlut-1)
  for (i in seq_len(nlut+1)-1) {
    pos <- delta + (i-1)*scale
    if (X) {
      x1 <- pos; x2 <- pos+scale; y1 <- y.range[1]; y2 <- y.range[2]
    } else {
      y1 <- pos; y2 <- pos+scale; x1 <- x.range[1]; x2 <- x.range[2]
    }
    if (i>0)
      rect(x1,y1,x2,y2, col=clut[i], border=border, xpd=TRUE)
    if (!is.null(values)) {
      rund <- format(round(min(values)+dM*i,max(1,digits)),digits=digits)
##      rund <- round((min(values)+dM*i)*10^digits)/(10^digits)
      x0 <- pos+(1+0.5)*scale; y0 <- y.range[2]+label.offset
      if (!X) { y0 <- x0; x0 <- x.range[1]-label.offset }
      if (i<nlut)
        text(x0,y0,rund,cex=cex,srt=srt,xpd=TRUE,...)
    }
  }
}