R/colGradLegend.R

In helophilus/ColsTools: A variety of convenience tools and short-cuts

#' Adds a colour gradient legend to a base plot
#'
#' \code{(x,y,colramp,colno,align=c("v","h"),lengthmult=1,width=2,labs=0:1,...)}
#'
#' @param x the x coordinate for the lowermost (if vertical) or leftmost
#' (if horizontal) end of the gradient bar.
#' @param y the y coordinate pairing to x.
#' @param colramp a colour ramp using, e.g., colorRampPalette().
#' @param colno the number of colours of the colour ramp in the gradient.
#' @param align whether the gradient bar should be aligned vertically ('v') or
#' horizontally ('h').
#' @param frac a multiplier for the length of the bar, given as a percentage
#' of the axis span. Default is 25.
#' @param width thickness of bar as a percentage of total axis range.
#' @param labs scale values to be printed alongside the bar. Must be at least 2.
#' @param tsize magnification factor for size of text labels
#' @param scaleoffset amount of offset between gradient bar and scale value. Value is
#' percentage of total scale, default is 0.
#' @param Round is the number of digits the scale values are rounded to.
#' @param ... other plotting arguments. Really designed for use of xpd = TRUE to
#' position the bar outside of the plotting area. Other plotting arguments have not
#' been tested and may produce errors.
#'
#' @details places a gradient bar on a plot along with labels and a title. There is
#' some flexibility though it has not been extensively tested.

colGradLegend = function(x,y,colramp,colno,align=c("v","h"),
                        frac=25,width=5,labs=0:1,tsize=0.8,
                        scaleoffset=0,Round=1,...){
  coor=par("usr")
  xspan = c(coor[1],coor[2])
  yspan = c(coor[3],coor[4])
  align = match.arg(align)
  xperc = diff(xspan)/100
  yperc = diff(yspan)/100
  S = ifelse(align=="h",x,y)
  span = if(align=="h")xspan else yspan
  series = seq(from=S, to = S + diff(span)*frac/100, length = colno+1)
  froms = series[1:(colno)]
  tos = series[2:(colno+1)]
  NL = length(labs)
  if(align=="v"){
    for(i in 1:(length(series)-1)){
      a = x; b = x + width*xperc; c = series[i]; d = series[i+1]
      polygon(c(a,a,b,b),c(c,d,d,c),col = colramp(colno)[i],
              border=colramp(colno)[i],...)
    }
    text(x + (width + scaleoffset) * xperc,seq(from=y,to=max(series),length=NL),
         labels=round(labs,Round),cex=tsize*0.8,pos=4,...)
  } else if (align=="h"){
    for(i in 1:(length(series)-1)){
      a = series[i]; b = series[i+1]; c = y; d = y + width*yperc
      polygon(c(a,a,b,b),c(c,d,d,c),col = colramp(colno)[i],
              border=colramp(colno)[i],...)
    }
    text(seq(from=x,to=max(series),length=NL), y - scaleoffset*yperc,
         labels=round(labs,Round),cex=0.8*tsize,pos=1,...)
  }
  par(usr=coor)
}