qtltools: Tools for plotting QTL

#' Creates an object needed to create QTL plots.
#'
#' Creates a list of information needed to plot QTL across a genome, for all or only a subset
#' of chromsomes.
#' For each chromosome specified a 'track' is created, which is further divided into lanes
#' for plotting QTL from different years or experiments. QTL positions and their confidence
#' intervals are plotted to the centre of these lanes, and dividing lanes plotted between
#' each lane. These lane centres and margin positions can be used to add extra information,
#' such as lane labels above the chromosome.
#' 
#' The gap between chromosomes can be adjusted to include further embellishments, and the plot
#' will rescale automatically.
#'
#' @param chr a numeric vector listing which chromosomes are to be plotted.
#' @param marker_locations A data.frame listing marker positions on each chromosome.
#' Should include a column labelled 'Position' and another labelled 'Chromosome'.
#' @param nlanes the number of lanes to plot for each chromosome. Defaults to two for Sweden vs. Italy.
#' left_gap, right_gap left- and right-hand margin around each chromosome.
#' @return A list of two tables detailing:
#' \enumerate{
#' \item  Chromosomes to be plotted
#' \item Number of chromosome tracks to be included
#' \item Number of lanes on each track
#' \item Lists of marker positions for each track
#' \item Lengths of each track
#' \item Gap to the left of each track
#' \item Gap to the right of each track
#' \item Table of x-axis poisitions of the centres of each lane.
#' \item Table of x-axis poisitions of the margins of each lane.
#' \item Optional list of labels for each lane.
#' }
#'
#' @export
plotQTL <-
function(chr=1:5, marker_locations, nlanes=2, left_gap=2, right_gap=2, lane_labels=NULL){
  nchr    <- length(chr) # number of chromosomes to plot 
  maxx    <- nchr * (10+left_gap+right_gap) - left_gap # right hand boundary of the plot
  chr_xv  <- 0:(nchr-1) * (10+left_gap+right_gap) # positions for the chromosome vertical lines
  
  # x-positions for the centre of each lane
  lane_xv     <- sapply(1:nchr, function(i) seq(chr_xv[i], chr_xv[i]+10, by=10/nlanes))
  lane_centre <- sapply(1:nchr, function(i) (seq(chr_xv[i], chr_xv[i]+10, by=10/nlanes)-(5/nlanes))[-1])
  # label row and column names
  rownames(lane_xv)     <- paste("margin", 1:(nlanes+1), sep="_")
  rownames(lane_centre) <- paste("lane", 1:nlanes, sep="_")
  colnames(lane_xv)     <- chr
  colnames(lane_centre) <- chr
  
  # create a list of marker positions for each track
  map <- list()
  for(c in 1:length(chr)) map <- append(map, list(marker_locations[marker_locations$Chromosome == chr[c],2]))
  
  # return a plotQTL object
  return(list(chr           = chr,
              ntracks       = length(chr),
              nlanes        = nlanes,
              map           = map,
              maxx          = maxx,
              track_lengths = unlist(lapply(map, max)),
              left_gap      = left_gap,
              right_gap     = right_gap,
              lane_centres  = lane_centre,
              lane_margins  = lane_xv,
              lane_labels   = lane_labels))
}