R/LDMap.r

In synbreed: Framework for the Analysis of Genomic Prediction Data using R

#' LD Heatmap
#'
#' Visualization of pairwise Linkage Disequilibrium (LD) estimates generated by
#' function \code{pairwiseLD} in a LD heatmap for each chromosome using the
#' \code{LDheatmap} package (Shin et al, 2006) .
#'
#' Note: If you have an \code{LDmat}-object with more than one chromosome and
#' you like to plot all chromosomes, you need to put an empty line for each
#' chromosome in your script after the LDMap function!
#'
#' @param LDmat Object of class \code{LDmat} generated by function
#' \code{pairwiseLD} and argument \code{type="matrix"}
#' @param gpData Object of class \code{gpData} that was used in
#' \code{pairwiseLD}
#' @param chr \code{numeric}. Return value is a plot for each chromosome in
#' \code{chr}.
#' @param file Optionally a path to a file where the plot is saved to
#' @param fileFormat \code{character}. At the moment two file formats are
#' supported: pdf and png. Default is \code{"pdf"}.
#' @param onefile \code{logical}. If \code{fileFormat = "pdf"} you can decide,
#' if you like to have all graphics in one file or in multiple files.
#' @param \dots Further arguments that could be passed to function
#' \code{LDheatmap}
#' @author Hans-Juergen Auinger, Theresa Albrecht and Valentin Wimmer
#' @seealso \code{\link{pairwiseLD}}, \code{\link[LDheatmap]{LDheatmap}},
#' \code{\link{LDDist}}
#' @references Shin JH, Blay S, McNeney B, Graham J (2006). LDheatmap: An R
#' Function for Graphical Display of Pairwise Linkage Disequilibria Between
#' Single Nucleotide Polymorphisms. Journal of Statistical Software, 16, Code
#' Snippet 3. URL http://stat-db.stat.sfu.ca: 8080/statgen/research/LDheatmap/.
#' @keywords hplot
#' @importFrom LDheatmap LDheatmap
#' @examples
#'
#' \dontrun{
#' library(synbreedData)
#' data(maize)
#' maizeC <- codeGeno(maize)
#'
#' # LD for chr 1
#' maizeLD <- pairwiseLD(maizeC, chr = 1, type = "matrix")
#' LDMap(maizeLD, maizeC)
#' }
#'
#' @export LDMap
#' @importFrom LDheatmap LDheatmap
#' @importFrom grDevices dev.off pdf png
#'
#'
LDMap <- function(LDmat, gpData, chr = NULL, file = NULL, fileFormat = "pdf", onefile = TRUE, ...) {

  # catch (possible) errors
  if (class(LDmat) != "LDmat") stop("'LDmat' must be of class 'LDmat'")
  if (is.null(chr)) {
    lg <- (1:length(LDmat$LD))[!as.logical(lapply(LDmat$LD, is.null))]
  } else {
    lg <- chr
  }
  if (class(gpData) == "gpData") {
    pos <- gpData$map$pos
    names(pos) <- rownames(gpData$map)
  } else {
    stop("gpData has to be of class gpData!")
  }

  # use LD from input arguement
  ret <- LDmat
  if (!is.null(file) & onefile & fileFormat == "pdf") {
    if (substr(file, nchar(file) - nchar(fileFormat) + 1, nchar(file)) != fileFormat | nchar(file) < 5) {
      file <- paste(file, ".", fileFormat, sep = "")
    }
    pdf(file, onefile = onefile)
  }

  for (i in lg) {
    if (!is.null(file) & (fileFormat != "pdf" | fileFormat == "pdf" & !onefile)) {
      if (substr(file, nchar(file) - nchar(fileFormat) + 1, nchar(file)) != fileFormat | nchar(file) < 5) {
        if (length(lg) < 2) {
          fileName <- paste(file, ".", fileFormat, sep = "")
        } else {
          fileName <- paste(file, "_chr", i, ".", fileFormat, sep = "")
        }
      } else {
        if (length(lg) > 1) {
          fileName <- paste(substr(file, 1, nchar(file) - nchar(fileFormat) - 1), "_chr", i, ".", fileFormat, sep = "")
        } else {
          fileName <- file
        }
      }
      if (fileFormat == "pdf") {
        pdf(fileName)
      } else if (fileFormat == "png") {
        png(fileName)
      } else {
        stop("not supported file format choosen!")
      }
    }
    color <- c("#7F0000", "#B30000", "#D7301F", "#EF6548", "#FC8D59", "#FDBB84", "#FDD49E", "#FEE8C8", "#FFF7EC")
    #   using function LDheatmap
    MapUnit <- ifelse(gpData$info$map.unit == "cM", "genetics", "physical")
    LDheatmap(LDmat$LD[[i]],
      LDmeasure = "r", color = color, genetic.distances = pos[rownames(LDmat$LD[[i]])], distances = MapUnit,
      geneMapLabelY = 0.12, geneMapLabelX = 0.35, title = paste("Pairwise LD on chromosome", i), ...
    )
    if (!is.null(file) & (fileFormat != "pdf" | fileFormat == "pdf" & !onefile)) {
      dev.off()
    } else if (is.null(file) & length(lg) > 1) readline()
  }
  if (!is.null(file) & onefile & fileFormat == "pdf") dev.off()
}