#' @title Get Pal
#' @author Thomas Bryce Kelly
#' @description A helper function to retrieve a vector of colors derived from a given palette generating function.
#' @keywords Colormap
#' @param n The number of colors desired.
#' @param pal A character string of the pallet generating function, defaults to pals::ocean.haline
#' @param rev A boolean used to flip the order of the colors.
#' @import pals
#' @export
get.pal = function(n = 10, pal = 'greyscale', rev = FALSE) {
## Get pal
pal = do.call(pal, list(n))
if (rev) { pal = rev(pal)}
## Return
pal
}
#' @title Make Pal
#' @author Thomas Bryce Kelly
#' @param x the values to be color coded
#' @param n the number of distinct colors to use
#' @param min the minimum value to correspond to the first color
#' @param max the maximum value to correspond to the last color
#' @param pal the pallete to use, default is ocean.haline
#' @param rev Boolean, reverse the color pallete?
#' @param clip boolean, remove out of range values? Defaults to False
#' @export
make.pal = function(x, n = 255, min = NA, max = NA, pal = 'greyscale', rev = FALSE, clip = FALSE) {
x = as.numeric(x)
min = as.numeric(min)
max = as.numeric(max)
cols = get.pal(n+1, pal = pal, rev = rev)
if (is.na(min)) { ## set a minimum
min = base::min(x, na.rm=TRUE)
}
if (is.na(max)) { ## Set a maximum
max = base::max(x, na.rm=TRUE)
}
## Force min and max
if (clip) {
x[x < min] = NA
x[x > max] = NA
} else {
x[x < min] = min
x[x > max] = max
}
if (max == min) {
x = x - min
} else {
x = (x - min) * n / (max - min) ## Scale so x falls between [0,n]
}
## Map to colors
cols = cols[floor(x)+1] # return the colors
cols[is.na(x)] = '#00000000' ## NA values are transparent
cols
}
#' @title Make Qualitative Palette
#' @author Thomas Bryce Kelly
#' @param x The categorical values to be colored
#' @param pal The palette to be used, default tol
#' @param rev Boolean, reverse the colors?
#' @export
make.qual.pal = function(x, pal = 'greyscale', rev = FALSE) {
x[is.na(x)] = 'other.vals'
## Determine numeric values
a = sapply(x, function(xx) {which(xx == unique(x))})
cols = get.pal(n = length(unique(x)), pal = pal, rev = rev)
cols[a]
}
#' @title Add Colorbar
#' @author Thomas Bryce Kelly
#' @param min The minimum value of the colorbar palette
#' @param max The maximum value of the colorbar palette
#' @param labels The values where labels should be included
#' @param ticks The values where tick marks should be included
#' @param pal The name of a color palette or a color palette function itself
#' @param rev Boolean if the palette color should be reversed
#' @param units A string for the zaxis label
#' @param col.high Color for above range values
#' @param col.low Color for below range values
#' @param log A boolean if the zaxis should be log tranformed
#' @param base The base for the log transformation
#' @param x.pos the position that the x-axis should be centered on (y axis if horizontal)
#' @param width The width of the colorbar
#' @param y.pos the position that the x-axis should be centered on (x axis if horizontal)
#' @param height The length of the colorbar
#' @param cex Size
#' @param cex.units The text size of the units string text
#' @param n The number of colors to be used in the colorbar
#' @param horizontal Whether the colorbar should be placed horizontally rather than vertically
#' @description Add a color bar to any graphical device such as a plot or map. The color bar can be based on any color palette function and be placed either vertically or horizontally.
#' @keywords Plotting
#' @export
add.colorbar = function(min,
max,
labels = NULL,
ticks = NULL,
labels.at = NULL,
pal = 'greyscale',
rev = FALSE,
units = '',
col.high = '',
col.low = '',
log = FALSE,
base = 10,
x.pos = NULL,
width = NULL,
y.pos = NULL,
height = NULL,
cex = 1,
cex.units = 1,
n = 255,
horizontal = FALSE,
col.lab = 'black',
col.tck = 'darkgrey') {
## Setup
par.original = par()
#for (p in c('cin', 'cra', 'csi', 'cxy', 'din', 'page')) { par.original[[p]] = NULL}
## Default Spacing
# width
if (is.null(width) & !horizontal) {
width = min(c(1 - par('plt')[2], 0.05))
}
if (is.null(width) & horizontal) {
width = par('plt')[2] - par('plt')[1]
}
#height
if (is.null(height) & horizontal) {
height = min(c(1 - par('plt')[4], 0.05))
}
if (is.null(height) & !horizontal) {
height = par('plt')[4] - par('plt')[3]
}
# x.pos
if (is.null(x.pos) & horizontal) {
x.pos = 0.5
}
if (is.null(x.pos) & !horizontal) {
x.pos = par('plt')[2] - width/2
}
#y.pos
if (is.null(y.pos) & horizontal) {
y.pos = par('plt')[4] - height/2
}
if (is.null(y.pos) & !horizontal) {
y.pos = 0.5
}
x = 1
y = c(0:n)
z = matrix(y, nrow = 1, ncol = length(y))
delta = NULL
## Determine axis labels and tick marks
if (is.null(labels.at)) {
labels.at = labels
} else {
if (length(labels.at) != length(labels)) {
stop('Length of label positions and label text are unequal!')
}
}
if(!is.null(labels.at)) {
labels = labels[labels.at >= min & labels.at <= max]
labels.at = labels.at[labels.at >= min & labels.at <= max]
} else {
if (log) {
labels.at = rep(1:(base-1), length(c(-30:30))) * base^as.numeric(sapply(c(-30:30), function(x) {rep(x, base-1)}))
} else {
labels.at = pretty(c(min, max), n = 6)
}
labels.at[labels.at < min] = min
labels.at[labels.at > max] = max
labels = labels.at
}
if (log) {
delta = (log(as.numeric(labels.at), base) - log(as.numeric(min), base)) / (log(as.numeric(max), base) - log(as.numeric(min), base))
} else {
delta = (as.numeric(labels.at) - as.numeric(min))/(as.numeric(max) - as.numeric(min))
}
# Ticks
if (!is.null(ticks)) {
ticks = ticks[ticks >= min & ticks <= max]
if (log) {
ticks.delta = (log(as.numeric(ticks), base) - log(as.numeric(min), base)) / (log(as.numeric(max), base) - log(as.numeric(min), base))
} else {
ticks.delta = (as.numeric(ticks) - as.numeric(min))/(as.numeric(max) - as.numeric(min))
}
}
## Now we get to work actually doing stuff:
par(new = TRUE, bty = 'n', plt = c(x.pos - width/2, x.pos + width/2, y.pos - height/2, y.pos + height/2))
if (horizontal) {
image(y, x, t(z), col = get.pal(n = length(y), pal = pal, rev = rev), xlim = c(-0.1 * n, 1.1 * n), zlim = range(z),
yaxt = 'n', xaxt = 'n', ylab = NA, xlab = NA, ylim = c(0,1))
}
else {
image(x, y, z, col = get.pal(n = length(y), pal = pal, rev = rev), ylim = c(-0.1 * n, 1.1 * n), zlim = range(z),
yaxt = 'n', xaxt = 'n', ylab = NA, xlab = NA, xlim = c(0,1))
}
## Add triangles
if (!is.na(col.high)) {
if (col.high == '') {
col.high = get.pal(100, pal, rev = rev)[100]
}
if (horizontal) {
polygon(y = c(0, 1, 0.5, 0.5), x = c(1, 1, 41/40, 41/40) * n + 0.5, col = col.high, border = NA)
} else {
polygon(x = c(0, 1, 0.5, 0.5), y = c(1, 1, 41/40, 41/40) * n + 0.5, col = col.high, border = NA)
}
}
if (!is.na(col.low)) {
if (col.low == '') {
col.low = get.pal(100, pal, rev = rev)[1]
}
if (horizontal) {
polygon(y = c(0, 1, 0.5, 0.5), x = c(0, 0, -n/40, -n/40)-0.5, col = col.low, border = NA)
} else {
polygon(x = c(0, 1, 0.5, 0.5), y = c(0, 0, -n/40, -n/40)-0.5, col = col.low, border = NA)
}
}
if (!horizontal) {mtext(units, side = 1, line = -1.5, cex = cex.units)}
else {mtext(units, side = 1, line = -1.5, cex = cex.units)}
if (!is.null(ticks)) {
if (horizontal) { axis(3, at = ticks.delta * (n+1) - 0.5, labels = NA, las = 1, col = col.tck) }
else { axis(4, at = ticks.delta * (n+1) - 0.5, labels = NA, las = 1, col = col.tck) }
}
if (!is.null(labels)) {
if (horizontal) { axis(3, at = delta * (n+1) - 0.5, labels = labels, las = 1, cex = cex, col = col.lab) }
else { axis(4, at = delta * (n+1) - 0.5, labels = labels, las = 1, cex = cex, col = col.lab) }
}
## Return margins to default
par(par.original)
}
#' @title Greyscale Palette
#' @export
#' @author Thomas Bryce Kelly
#' @param n the number of greyscale colors desired
#' @param rev a boolean flag to reverse the color palette
greyscale = function(n, rev = FALSE) {
grey.colors(n, 0, 1, rev = rev)
}
#' @export
add.alpha = function(pal) {
f = function(n) {
alpha.vals = (c(0:(n-1))/(n-1))
scales::alpha(do.call(pal, list(n)), alpha.vals)
}
return(f)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.