# =============================================================================.
#' 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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.