R/plotMatrix.R

In distantia: Assessing Dissimilarity Between Multivariate Time Series

#' Plots distance matrices and least cost paths.
#'
#' @description Plots the output matrices of \code{\link{distanceMatrix}} and \code{\link{leastCostMatrix}}, and superimposes the least cost path generated by \code{\link{leastCostPath}}. This functions relies on \code{\link[fields]{image.plot}} to plot a color scale along with the matrix plot, or \code{\link[graphics]{image}} when a color scale is not needed.
#'
#' @usage plotMatrix(
#'   distance.matrix = NULL,
#'   least.cost.path = NULL,
#'   plot.columns = NULL,
#'   plot.rows = NULL,
#'   legend = TRUE,
#'   color.palette = "divergent",
#'   path.color = "black",
#'   path.width = 1,
#'   margins = c(2,3,2,4),
#'   pdf.filename = NULL,
#'   pdf.width = 7,
#'   pdf.height = 4,
#'   pdf.pointsize = 12,
#'   rotate = FALSE
#'   )
#'
#' @param distance.matrix numeric matrix or list of numeric matrices either produced by \code{\link{distanceMatrix}} or \code{\link{leastCostMatrix}}.
#' @param least.cost.path dataframe or list of fdataframes produced by \code{\link{leastCostPath}}. If a list, must have the same number of slots as \code{distance.matrix}.
#' @param plot.columns number of columns of the output plot if the inputs are lists. If not provided, it is computed automatically by \code{\link[grDevices]{n2mfrow}}.
#' @param plot.rows number of rows of the output plot if the inputs are lists. If not provided, it is computed automatically by \code{\link[grDevices]{n2mfrow}}.
#' @param legend boolean. If \code{TRUE}, the plot is made with \code{\link[fields]{image.plot}}, and includes a color scale on the right side. If \code{FALSE}, the plot is made with \code{\link[graphics]{image}}, and the color scale is omitted.
#' @param color.palette string defining the color palette to be used, or a color palette. Accepted strings are "divergent" (default), which uses a red-white-blue divergent palette produced by the code \code{colorRampPalette(rev(RColorBrewer::brewer.pal(9, "RdBu")))(100)}, and "viridis", which uses the default settings of the \code{\link[viridis]{viridis}} function to generate the palette. Both settings are color-blind friendly.
#' @param path.color string, color of the line representing the least cost path if \code{least.cost.path} is provided.
#' @param path.width line width (lwd) of the plotted path.
#' @param margins a numeric vector with four positions indicating the margins of each plotted matrix. Order of margins in this vector is: bottom, left, top, right.

#' @param pdf.filename character string with the name, without extension, of the pdf to be written. If \code{NULL}, no pdf is written.
#' @param pdf.width with in inches of the output pdf. Default value is 7.
#' @param pdf.height height in inches of the output pdf. Default value is 4.
#' @param pdf.pointsize base font size of the output pdf.
#' @param rotate boolean, if \code{TRUE}, the matrix is rotated. Allows the user to plot the matrix axes in the desired direction.
#'
#'
#'
#' @return A list of dataframes if \code{least.cost.matrix} is a list, or a dataframe if \code{least.cost.matrix} is a matrix. The dataframe/s have the following columns:
#' \itemize{
#' \item \emph{A} row/sample of one of the sequences.
#' \item \emph{B} row/sample of one the other sequence.
#' \item \emph{distance} distance between both samples, extracted from \code{distance.matrix}.
#' \item \emph{cumulative.distance} cumulative distance at the samples \code{A} and \code{B}.
#' }
#' @examples
#'
#' \donttest{
#'#loading data
#'data(sequenceA)
#'data(sequenceB)
#'
#'#preparing datasets
#'AB.sequences <- prepareSequences(
#'  sequence.A = sequenceA,
#'  sequence.A.name = "A",
#'  sequence.B = sequenceB,
#'  sequence.B.name = "B",
#'  merge.mode = "complete",
#'  if.empty.cases = "zero",
#'  transformation = "hellinger"
#'  )
#'
#'#computing distance matrix
#'AB.distance.matrix <- distanceMatrix(
#'  sequences = AB.sequences,
#'  grouping.column = "id",
#'  method = "manhattan",
#'  parallel.execution = FALSE
#'  )
#'
#'#plot
#'plotMatrix(distance.matrix = AB.distance.matrix)
#'
#'#viridis palette
#'plotMatrix(distance.matrix = AB.distance.matrix,
#'  color.palette = "viridis")
#'
#'#custom palette
#'plotMatrix(distance.matrix = AB.distance.matrix,
#' color.palette = viridis::viridis(8, option = "B", direction = -1))
#'
#' }
#'
#' @export
plotMatrix <- function(distance.matrix = NULL,
                       least.cost.path = NULL,
                       plot.columns = NULL,
                       plot.rows = NULL,
                       legend = TRUE,
                       color.palette = "divergent",
                       path.color = "black",
                       path.width = 1,
                       margins = c(2,3,2,4),
                       pdf.filename = NULL,
                       pdf.width = 7,
                       pdf.height = 4,
                       pdf.pointsize = 12,
                       rotate = FALSE
                       ){


  #if input is matrix, get it into list
  if(inherits(distance.matrix, "list") == TRUE){
    n.elements <- length(distance.matrix)
  } else {
    temp <- list()
    temp[[1]] <- distance.matrix
    distance.matrix <- temp
    names(distance.matrix) <- "A|B"
  }

  #if input is matrix, get it into list
  if(!is.null(least.cost.path)){
    if(inherits(least.cost.path, "list") == TRUE){
      m.elements <- length(least.cost.path)
    } else {
        temp <- list()
        temp[[1]] <- least.cost.path
        least.cost.path <- temp
        names(least.cost.path) <- "A|B"
    }


    if(n.elements != m.elements){
      stop("Arguments 'distance.matrix' and 'least.cost.matrix' don't have the same number of slots.")
    }

    if(n.elements > 1){
      if(sum(names(distance.matrix) %in% names(least.cost.path)) != n.elements){
        stop("Elements in arguments 'distance.matrix' and 'least.cost.path' don't have the same names.")
      }
    }

  }

  #number of elements in distance.matrix
  if(inherits(distance.matrix, "list") == TRUE){
    n.elements <- length(distance.matrix)
  }

  #trying to guess plot.columns and plot.rows if they are null
  if(is.null(plot.columns) & is.null(plot.rows)){
    plot.rows.columns <- grDevices::n2mfrow(n.elements)
  } else {
    plot.rows.columns <- c(plot.rows, plot.columns)
  }

  #defaults for figure width and heights
  if(is.null(pdf.height)){pdf.height <- plot.rows.columns[1]*6}
  if(is.null(pdf.width)){pdf.height <- plot.rows.columns[2]*10}
  if(is.null(pdf.pointsize)){pdf.pointsize <- 15}

  #color palette
  if(length(color.palette) == 1){
    if(color.palette %in% c("divergent", "Divergent", "DIVERGENT", "redblue", "rb")){
      color.palette <- colorRampPalette(rev(RColorBrewer::brewer.pal(9, "RdBu")))(100)
    } else {
      if(color.palette %in% c("viridis", "Viridis", "VIRIDIS", "greens")){
        color.palette <- viridis::viridis(100, direction = -1)
      }
    }
  }

  #opening pdf if filename is not null
  if(!is.null(pdf.filename)){
    grDevices::pdf(file = paste(pdf.filename, ".pdf", sep=""), width = pdf.width, height=pdf.height, pointsize = pdf.pointsize)
  }

  #plot dimensions
  user.par <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(user.par))
  graphics::par(mfrow = plot.rows.columns, mar = margins, oma = c(1,1,1,1))

  #iterating through elements in distance.matrix
  for(i in 1:n.elements){

    #getting distance matrix
    distance.matrix.i <- distance.matrix[[i]]

    #matrix name
    matrix.name <- names(distance.matrix)[i]

    #parse names
    sequence.names = unlist(strsplit(matrix.name, split='|', fixed=TRUE))
    if(length(sequence.names) == 0){
      ylab.name <- "A"
      xlab.name <- "B"
      title <- "A vs. B"
    } else {
      ylab.name <- sequence.names[1]
      xlab.name <- sequence.names[2]
      title <- paste(sequence.names, collapse = " vs. ")
    }

    #getting path
    if(!is.null(least.cost.path)){
      path.i <- least.cost.path[[i]]
    }

    #no rotation
    if(rotate == FALSE){

      #plot
      if(legend == FALSE){
      graphics::image(x = 1:nrow(distance.matrix.i),
                       y = 1:ncol(distance.matrix.i),
                       z = distance.matrix.i,
                       xlab = ylab.name,
                       ylab = xlab.name,
                       main = title,
                       col = color.palette)
      }

      if(legend == TRUE){
        fields::image.plot(x = 1:nrow(distance.matrix.i),
              y = 1:ncol(distance.matrix.i),
              z = distance.matrix.i,
              xlab = ylab.name,
              ylab = xlab.name,
              main = title,
              col = color.palette)
      }

      #add path
      if(!is.null(least.cost.path)){
         graphics::lines(path.i[, ylab.name], path.i[, xlab.name], lwd=path.width, col = path.color)
      }

    } #enf of rotate = FALSE


    #rotated plot
    if(rotate == TRUE){

      #plot
      if(legend == FALSE){
        graphics::image(y = 1:nrow(distance.matrix.i),
                        x = 1:ncol(distance.matrix.i),
                        z = t(distance.matrix.i),
                        ylab = ylab.name,
                        xlab = xlab.name,
                        main = title,
                        col = color.palette)
      }

      if(legend == TRUE){
        fields::image.plot(y = 1:nrow(distance.matrix.i),
                           x = 1:ncol(distance.matrix.i),
                           z = t(distance.matrix.i),
                           ylab = ylab.name,
                           xlab = xlab.name,
                           main = title,
                           col = color.palette)
      }

      #add path
      if(!is.null(least.cost.path)){
        graphics::lines(path.i[, xlab.name], path.i[, ylab.name], lwd=path.width, col = path.color)
      }



    }

  }#end of iterations

}