R/makeColors.R

In benja0x40/MRA.TA: Multi Resolution Analysis of Tiling Arrays

# =============================================================================.
#' Represent numerical values by a color vector
# -----------------------------------------------------------------------------.
#' @author Benjamin Leblanc
#' @export makeColors
#' @seealso
#'   \link{domainogram}
# -----------------------------------------------------------------------------.
#' @description
#' makeColors builds a vector of RGB colors to represent numerical values.
#' This color representation is generated by applying piecewise color mapping
#' to input values.
#'
#' @details
#   log(p value)    color gradient
#     0 to   -10	=>	white	to blue
#   -10 to   -50	=>	blue	to yellow
#   -50 to  -500	=>	yellow	to red
#  -500 to -5000	=>	red	to black
# -----------------------------------------------------------------------------.
#' @param p
#' vector of positive numeric values.
#'
#' @param thresholds
#' numeric vector defining the boundaries between ranges of values to be
#' mapped into a specific color interval (default = c(10, 50, 500, 5000)).
#'
#' @param colors
#' color vector providing the colors representing each threshold value
#' (default = c("blue", "yellow", "red", "black")).
#'
#' @param background
#' color representing p = 0, which is set to "white" by default.
#'
#' @param overflow
#' color representing p > max(thresholds), which is set to "white" by default.
# -----------------------------------------------------------------------------.
#' @return makeColors returns a character vector of RGBA colors in hexadecimal.
# -----------------------------------------------------------------------------.
#' @examples
# Mi <- ((cos(2*pi*(-800:800)/1600) + 1)^4)/5+3*cos(2*pi*(-800:800)/240)+2*rnorm(1601)
# Qi <- calc.Qi(Mi)
# Yi <- log(Qi)
# colors <- makeColors(Yi, thresholds=10, colors="black", overflow="red")
# -----------------------------------------------------------------------------.
makeColors <- function(p, thresholds = c(10, 50, 500, 5000), colors = c("blue","yellow","red","black"), background = "white", overflow = "white") {

  # Utility function, transforms a range of values into a range of colors
  p2c <- function (p, p.a, p.b, c.a, c.b) {
    i <- floor(256*(p-p.a)/(p.b-p.a))/255
    x <- c.a[1] + i*(c.b[1]-c.a[1])
    y <- c.a[2] + i*(c.b[2]-c.a[2])
    z <- c.a[3] + i*(c.b[3]-c.a[3])
    rgb(x,y,z)
  }

  n.col      <- length(colors)
  colors     <- t(col2rgb(colors)/255)
  background <- as.vector(t(col2rgb(background)/255))

  p[p==-Inf] <- thresholds[1]
  p[is.na(p) | p==Inf] <- thresholds[length(thresholds)]

  p.col <- rep(rgb(1,1,1),length(p))

  p <- abs(p)
  thresholds <- abs(thresholds)

  # Colors for p-values above the least significant threshold
  x <- which(p<thresholds[1])
  if(length(x)>0) {
    p.col[x] <- p2c(p[x], 0, thresholds[1], background, as.vector(colors[1,]))
  }

  # Colors for intermediate p-values
  for(k in 2:n.col) {
    x <- which(p>=thresholds[k-1] & p<thresholds[k])
    if(length(x)>0) {
      p.col[x] <- p2c(p[x], thresholds[k-1], thresholds[k], as.vector(colors[k-1,]), as.vector(colors[k,]))
    }
  }

  # Colors for p-values below the most significant threshold
  x <- which(p>=thresholds[n.col])
  if(length(x)>0) {
    p.col[x] <- overflow
  }

  p.col
}