R/add_Cscale.R

In CCAMLRGIS: Antarctic Spatial Data Manipulation

#' Add a color scale
#'
#' Adds a color scale to plots. Default behavior set for bathymetry. May also be used to 
#' place a \code{\link[graphics]{legend}}.
#' 
#' @param pos character, fraction indicating the vertical position of the color scale (which, by default, is on the 
#' right side of plots). if \code{pos="1/1"}, the color scale will be centered. 
#' if \code{pos="1/2"}, the color scale will be centered on the top half of the plotting region.
#' if \code{pos="2/2"}, the color scale will be centered on the bottom half of the plotting region.
#' @param title character, title of the color scale.
#' @param width numeric, width of the color scale box, expressed in \% of the width of the plotting region.
#' @param height numeric, height of the color scale box, expressed in \% of the height of the plotting region.
#' @param cuts numeric, vector of color classes. May be generated via \code{\link{add_col}}.
#' @param cols character, vector of color names. May be generated via \code{\link{add_col}}.
#' @param minVal numeric, if desired, the color scale may be generated starting from the value \code{minVal}. See examples.
#' @param maxVal numeric, if desired, the color scale may be generated up to the value \code{maxVal}. See examples.
#' @param fontsize numeric, size of the text in the color scale.
#' @param offset numeric, controls the horizontal position of the color scale.
#' @param lwd numeric, thickness of lines.
#' @param Titlefontsize numeric, size of the title text.
#' @param TitleVAdj numeric, vertical adjustment of the title.
#' @param BoxAdj numeric vector of 4 values to adjust the sides of the box, given as \code{c(bottom,left,top,right)}.
#' @param BoxCol Color of the legend box frame.
#' @param BoxBG Color of the legend box background.
#' @param mode character, if 'Cscale', the default, the function builds a color scale. if 'Legend', the function
#' gives you the location of a \code{\link[graphics]{legend}}, arguments \code{pos}, \code{offset} and \code{height}
#' may be used for adjustments. See examples.
#' 
#' @seealso 
#' \code{\link{load_Bathy}}, \code{\link{SmallBathy}}, \code{\link{Depth_cuts}}, \code{\link{Depth_cols}}, 
#' \code{\link{Depth_cuts2}}, \code{\link{Depth_cols2}}, \code{\link{add_col}},
#' \href{http://www.stat.columbia.edu/~tzheng/files/Rcolor.pdf}{R colors}, \code{\link[graphics]{legend}}.
#' 
#' @examples
#' 
#' # For more examples, see:
#' # https://github.com/ccamlr/CCAMLRGIS#5-adding-colors-legends-and-labels
#' 
#' library(terra)
#' 
#' #Example 1: Adding two color scales
#' 
#' plot(SmallBathy(),breaks=Depth_cuts,col=Depth_cols,legend=FALSE,axes=FALSE,box=FALSE)
#' add_Cscale(pos='1/2',height=45,maxVal=0,minVal=-4000,fontsize=0.8)
#' #Some gridded data
#' MyGrid=create_PolyGrids(GridData,dlon=2,dlat=1)
#' Gridcol=add_col(MyGrid$Catch_sum,cuts=10)
#' plot(st_geometry(MyGrid),col=Gridcol$varcol,add=TRUE)
#' #Add color scale using cuts and cols generated by add_col, note the use of 'round'
#' add_Cscale(pos='2/2',height=45,title='Catch (t)',
#'            cuts=round(Gridcol$cuts,1),cols=Gridcol$cols,fontsize=0.8)
#' 
#' #Example 2: Adding a color scale and a legend
#' 
#' #Create some point data
#' MyPoints=create_Points(PointData)
#' 
#' #Crop the bathymetry to match the extent of MyPoints 
#' 
#' BathyCr=crop(SmallBathy(),extend(ext(MyPoints),100000))
#' plot(BathyCr,breaks=Depth_cuts,col=Depth_cols,legend=FALSE,axes=FALSE,mar=c(0,0,0,7))
#' add_Cscale(pos='1/2',height=45,maxVal=0,minVal=-4000,fontsize=0.8)
#' 
#' #Plot points with different symbols and colors (see ?points)
#' Psymbols=c(21,22,23,24)
#' Pcolors=c('red','green','blue','yellow')
#' plot(st_geometry(MyPoints[MyPoints$name=='one',]),pch=Psymbols[1],bg=Pcolors[1],add=TRUE)
#' plot(st_geometry(MyPoints[MyPoints$name=='two',]),pch=Psymbols[2],bg=Pcolors[2],add=TRUE)
#' plot(st_geometry(MyPoints[MyPoints$name=='three',]),pch=Psymbols[3],bg=Pcolors[3],add=TRUE)
#' plot(st_geometry(MyPoints[MyPoints$name=='four',]),pch=Psymbols[4],bg=Pcolors[4],add=TRUE)
#' 
#' #Add legend with position determined by add_Cscale
#' Loc=add_Cscale(pos='2/2',height=45,mode='Legend')
#' legend(Loc,legend=c('one','two','three','four'),title='Vessel',pch=Psymbols,
#' pt.bg=Pcolors,xpd=TRUE)
#' 
#' @export

add_Cscale=function(pos='1/1',title='Depth (m)',width=18,height=70,
              cuts=Depth_cuts,cols=Depth_cols,
              minVal=NA,maxVal=NA,fontsize=1,offset=100,lwd=1,
              Titlefontsize=1.2*fontsize,TitleVAdj=0,BoxAdj=c(0,0,0,0),
              BoxCol="black",BoxBG="white",
              mode="Cscale"){
  offset=offset*1000
  #Get plot boundaries
  ls=par("usr")
  xmin=ls[1]
  xmax=ls[2]
  ymin=ls[3]
  ymax=ls[4]
  xdist=xmax-xmin
  ydist=ymax-ymin
  
  #Midpoint
  n=as.numeric(strsplit(pos,'/')[[1]])
  N=n[2]
  n=n[1]
  ymid=seq(ymax,ymin,length.out=2*N+1)[seq(2,n+N,by=2)[n]]
  
  #Overall box
  bxmin=xmax+0.005*xdist+offset
  bxmax=xmax+(width/100)*xdist+offset
  bymin=ymid-(height/200)*ydist
  bymax=ymid+(height/200)*ydist
  
  if(mode=='Legend'){
    out=cbind(x=bxmin,y=bymax)
    return(out)
  }else{
  
  #constrain colors and breaks
    cutsTo=cuts
    colsTo=cols
    
    if(is.na(minVal)==FALSE & is.na(maxVal)==FALSE){
      if(minVal>=maxVal){stop("minVal should be inferior to maxVal")}
    }
    
    if(is.na(minVal)==FALSE){
      indx=which(cuts>=minVal)[1]
      if(cuts[indx]>minVal & indx>1){indx=indx-1}
      cutsTo=cuts[indx:length(cuts)]
      colsTo=cols[indx:length(cols)]
      cuts=cutsTo
      cols=colsTo
    }
    if(is.na(maxVal)==FALSE){
      indx=rev(which(cuts<=maxVal))[1]
      if(cuts[indx]<maxVal & indx<length(cuts)){indx=indx+1}
      cutsTo=cuts[1:indx]
      colsTo=cols[1:(indx-1)]
    }

  #plot Overall box
  rect(xleft=bxmin+BoxAdj[2]*xdist,
       ybottom=bymin+BoxAdj[1]*ydist,
       xright=bxmax+BoxAdj[4]*xdist,
       ytop=bymax+BoxAdj[3]*ydist,
       xpd=TRUE,lwd=lwd,col=BoxBG,border=BoxCol)
  #Col box
  cxmin=bxmin+0.01*xdist
  cxmax=bxmin+0.05*xdist
  cymin=bymin+0.02*ydist
  cymax=bymax-0.07*ydist
  Ys=seq(cymin,cymax,length.out=length(colsTo)+1)
  rect(xleft=cxmin,
       ybottom=Ys[1:(length(Ys)-1)],
       xright=cxmax,
       ytop=Ys[2:length(Ys)],xpd=TRUE,lwd=0,col=colsTo)
  rect(xleft=cxmin,
       ybottom=cymin,
       xright=cxmax,
       ytop=cymax,xpd=TRUE,lwd=lwd)
  #Ticks
  segments(x0=cxmax,
           y0=Ys,
           x1=cxmax+0.01*xdist,
           y1=Ys,lwd=lwd,xpd=TRUE,lend=1)
  text(cxmax+0.02*xdist,Ys,
       cutsTo,adj=c(0,0.5),xpd=TRUE,cex=fontsize)
  #Title
  text(cxmin,cymax+0.04*ydist+TitleVAdj*ydist,title,
       cex=Titlefontsize,adj=c(0,0.5),xpd=TRUE)
  }
}