R/utils_matrix_guide.R

In distantia: Advanced Toolset for Efficient Time Series Dissimilarity Analysis

#' Color Guide for Matrix Plot
#'
#' @description
#' Plots a color legend for a distance or cost matrix for multi-panel plots or external image editors.
#'
#' @param m (required, numeric matrix) distance or cost matrix generated by [psi_distance_matrix()] or [psi_cost_matrix()], but any numeric matrix will work. Default: NULL
#' @param matrix_color (optional, character vector) vector of colors. Default: NULL
#' @param breaks (optional, numeric vector) vector of breaks for the color guide. Default: NULL
#' @param title (optional, character string) guide title. Default: NULL
#' @param text_cex (optional, numeric) multiplier for the text size. Default: 1
#' @return Plot
#' @examples
#' #prepare time series list
#' tsl <- tsl_simulate(
#'   n = 2,
#'   independent = TRUE
#' )
#'
#' #distance matrix between time series
#' dm <- psi_distance_matrix(
#'   x = tsl[[1]],
#'   y = tsl[[2]]
#' )
#'
#' if(interactive()){
#'   utils_matrix_guide(m = dm)
#' }
#' @export
#' @autoglobal
#' @family internal_plotting
utils_matrix_guide <- function(
    m = NULL,
    matrix_color = NULL,
    breaks = NULL,
    title = NULL,
    text_cex = 1
){

  #check m
  m <- utils_check_args_matrix(m = m)

  title_cex <- 0.8 * text_cex
  axis_labels_cex <- 0.7 * text_cex
  title_distance <- 0.75

  if(inherits(x = m, what = "matrix") == FALSE){
    stop("distantia::utils_matrix_guide(): argument 'm' must be a distance or cost matrix resulting from distantia::psi_distance_matrix() or distantia::psi_cost_matrix().", call. = FALSE)
  }

  if(is.null(matrix_color)){
    matrix_color = color_continuous(
      n = 100
    )
  }

  if(is.null(breaks)){
    breaks <- utils_color_breaks(
      m = m,
      n = length(matrix_color)
    )
  }

  #guide values
  guide_values <- (
    breaks[1:(length(breaks)-1)] +
      breaks[2:length(breaks)]
  )/2

  #guide title
  if(is.null(title)){

    distance <- attributes(m)$distance

    if(is.character(distance)){
      distance <- tools::toTitleCase(distance)
    }

    type <- attributes(m)$type

    if("distance" %in% type){

      title <- ifelse(
        test = is.null(distance),
        yes = "Distance",
        no = paste(distance , "\ndistance")
      )

    }

    if("cost" %in% type){

      title <- ifelse(
        test = is.null(distance),
        yes = "Cost",
        no = paste(distance , "\ncost")
      )

    }

  }

  graphics::image(
    x = 1:2,
    y = breaks,
    z = matrix(
      guide_values,
      nrow = 1,
      ncol = length(guide_values)
    ),
    xaxt = "n",
    yaxt = "n",
    xlab = "",
    ylab = "",
    col = matrix_color,
    breaks = breaks
  )

  graphics::title(
    main = title,
    cex.main = title_cex,
    line = title_distance,
    adj = 0
  )

  graphics::axis(
    side = 4,
    las = 2,
    cex.axis = axis_labels_cex
  )

}