R/kpAddCytobandLabels.R

In karyoploteR: Plot customizable linear genomes displaying arbitrary data

#' kpAddCytobandLabels
#' 
#' @description 
#' 
#' Plots the base numbers along the chromosome ideograms
#' 
#' @details 
#'  
#' This function can be used to add labels idenfifying the cytobands. It gets the
#' labels from the cytobands information stored in the karyoplot object and it will
#' only plot the labels that fit inside the available space. This means than in some 
#' cases (such as when plotting a complete genome with default parameters) it is 
#' possible that no labels at all are added.
#' 
#' @usage kpAddCytobandLabels(karyoplot, cex=0.5, force.all=FALSE, clipping=TRUE, ...)
#' 
#' @param karyoplot  (karyoplot object) A valid karyoplot object created by a call to \code{\link{plotKaryotype}}
#' @param cex  (numeric) The cex parameter for the cytoband labels
#' @param force.all  (boolean) If true, all cytoband labels are plotted, even if they do not fit into the cytobands (Defaults to FALSE)
#' @param clipping  (boolean) Only used if zooming is active. If TRUE, the name will be not drawn out of the drawing are (i.e. in margins, etc) even if the data overflows the drawing area. If FALSE, the labels may overflow into the margins of the plot. (defaults to TRUE)
#' @param ...  Any other parameter to be passed to internal function calls. Specially useful for graphic parameters.
#' 
#' @return
#' 
#' Returns the original karyoplot object, unchanged.
#'  
#' @seealso \code{\link{plotKaryotype}}
#' 
#' @examples
#'   
#' kp <- plotKaryotype()
#' kpAddBaseNumbers(kp)
#' kpAddCytobandLabels(kp)
#' 
#' kp <- plotKaryotype(chromosomes="chr17")
#' kpAddBaseNumbers(kp, tick.dist=10000000, minor.tick.dist=1000000)
#' kpAddCytobandLabels(kp)
#' 
#'  
#' @export kpAddCytobandLabels
#' 


#TODO: Reimplement using kpText on data.panel="ideogram" (keep the "check if fits" code) before that

#TODO: With the change above, add the possibility to adjust the cytoband labels y position
kpAddCytobandLabels <- function(karyoplot, cex=0.5, force.all=FALSE, clipping=TRUE, ...) {
  if(!methods::is(karyoplot, "KaryoPlot")) stop("'karyoplot' must be a valid 'KaryoPlot' object")
  
  karyoplot$beginKpPlot()
  on.exit(karyoplot$endKpPlot())
  
  
  ccf <- karyoplot$coord.change.function
  pp <- karyoplot$plot.params
      
  if(!is.null(karyoplot$cytobands)) {
    if(length(karyoplot$cytobands)>0) { #If there are cytobands to plot, plot them
  
      labels <- karyoplot$cytobands$name
      bands.chr <- as.character(seqnames(karyoplot$cytobands))
      
      ylabel <- karyoplot$ideogram.mid(bands.chr)
      
      bandxleft <- ccf(x=start(karyoplot$cytobands), chr=bands.chr, data.panel="ideogram")$x
      bandxright <- ccf(x=end(karyoplot$cytobands), chr=bands.chr, data.panel="ideogram")$x
      
      bandmids <- (bandxleft +(bandxright-bandxleft)/2)
      
      label.width <- graphics::strwidth(labels, cex=cex)
      
      if(force.all == FALSE) {
        do.fit <- label.width < (bandxright - bandxleft)
      } else {
        do.fit <- rep(TRUE, length(labels))
      }    
      
      if(any(do.fit)) {
        if(karyoplot$zoom==TRUE) {
          if(clipping==TRUE) {
            #get the plot coordinates of the cytobands drawing area
            clip.xleft <- ccf(x=start(karyoplot$plot.region), chr=as.character(seqnames(karyoplot$plot.region)), data.panel="ideogram")$x
            clip.xright <- ccf(x=end(karyoplot$plot.region), chr=as.character(seqnames(karyoplot$plot.region)), data.panel="ideogram")$x
            clip.ybottom <- karyoplot$plot$ymin #We do not want to clip the text above or below the ideograms
            clip.ytop <- karyoplot$plot$ymax
            graphics::clip(x1 = clip.xleft, x2 = clip.xright, y1 = clip.ybottom, y2=clip.ytop)
          }
        }
        graphics::text(x=bandmids[do.fit], y=ylabel[do.fit], labels=labels[do.fit], cex=cex, ...)
      }
      
    }
  }
  #If no cytobands are available, do nothing
  
  invisible(karyoplot)
}