Nothing
ct <- NULL # This will be our V8 context
# Helper Function to sample n values from 1:N distributed evenly.
# e.g.
# getIndexes(255,3) = c(1,128,255)
# getIndexes(255,5) = c(1,64,128,192,255)
getIndexes <- function(N,n) {
if(N< n) {
stop("n should be < N")
}
# shortcut for n=1|2|N
if(n==1) {
c(N)
} else if(n==2) {
c(1,N)
} else if(n==N) {
1:N
} else {
c(1, ceiling(1:(n-2)*N/(n-1)) ,N)
}
}
#' List of pre-defined colormaps
#' @export
colormaps <- list(
jet='jet',
hsv='hsv',
hot='hot',
cool='cool',
spring='spring',
summer='summer',
autumn='autumn',
winter='winter',
bone='bone',
copper='copper',
greys='greys',
YIGnBu='YIGnBu',
greens='greens',
YIOrRd='YIOrRd',
bluered='bluered',
RdBu='RdBu',
picnic='picnic',
rainbow='rainbow',
portland='portland',
blackbody='blackbody',
earth='earth',
electric='electric',
viridis='viridis',
inferno='inferno',
magma='magma',
plasma='plasma',
warm='warm',
cool='cool',
rainbow_soft='rainbow-soft',
bathymetry='bathymetry',
cdom='cdom',
chlorophyll='chlorophyll',
density='density',
freesurface_blue='freesurface-blue',
freesurface_red='freesurface-red',
oxygen='oxygen',
par='par',
phase='phase',
salinity='salinity',
temperature='temperature',
turbidity='turbidity',
velocity_blue='velocity-blue',
velocity_green='velocity-green',
cubehelix='cubehelix'
)
#' Generate colors from a list of 44 palettes
#'
#' @export
#' @param colormap A string, vector of hex color codes, or a list.
#' Use the \code{\link{colormaps}} for a list of pre-defined palettes.
#' OR
#' A vector of colors in hex e.g. \code{c('#000000','#777777','#FFFFFF')}
#' OR
#' A list of list e.g. \code{list(list(index=0,rgb=c(255,255,255)),list(index=1,rgb=c(255,0,0)))}
#' The index should go from 0 to 1. see \url{https://www.npmjs.com/package/colormap#options}
#' @param nshades A number.
#' Number of colors to generate.
#' @param format A string.
#' Should be 'hex', 'rgb', or 'rgbaString'
#' @param alpha A Number between 0 and 1
#' @param reverse Boolean. Whether to reverse the order.
#'
#' @return Colors either in vector, matrix, list format depending on format.
#' @examples
#' colormap() # Defaults to 72 colors from the 'viridis' palette.
#' colormap(colormap=colormaps$temperature, nshades=20) # Diff Palette
#' colormap(colormap=c('#000000','#FF0000'), nshades=20) # Colormap as vector of colors
#' # list of list. Maximum flexibility
#' colormap(colormap=list(list(index=0,rgb=c(0,0,0)),list(index=1,rgb=c(255,255,255))), nshades=10)
#' colormap(format='rgb',nshades=10) # As rgb
#' colormap(format='rgb',nshades=10,alpha=0.5) # Constant alpha
#' colormap(format='rgbaString',nshades=10) # As rgba string
colormap <- function(colormap=colormaps$viridis, nshades=72,
format='hex', alpha=1, reverse=FALSE) {
# validate inputs
if(inherits(colormap,'character')) {
if(length(colormap)==1 && ! (colormap %in% colormaps) ) {
stop(sprintf("Unrecognised colormap: '%s'.\n See the colormap::colormaps for a list of allowed colormaps",
colormap))
} else if(length(colormap)>1 && !(all(grepl('^#[0-9a-f]{6}$',colormap,
ignore.case = T)))) {
stop("colormap parameter should be a single string from the colormap::colormaps list or a vector of strings in HEX color format\n e.g. colormap='viridis' or colormap=c('#FCFDA1','#FF0033')")
}
} else if(!inherits(colormap,'list')) {
stop("colormap parameter should be a single string from the colormap::colormaps list or a vector of strings in HEX color format\n e.g. colormap='viridis' or colormap=c('#FCFDA1','#FF0033') or a list of lists e.g. colormap=list(list(index=0,rgb=c(0,0,0)),list(index=1,rgb=c(255,255,255)))")
}
if(!(is.numeric(alpha) && alpha >=0 && alpha <= 1)) {
stop("alpha needs to be a number between 0 and 1")
}
if(!(format %in% c('hex', 'rgb', 'rgbaString'))) {
stop("format should be one of 'hex', 'rgb', 'rgbaString'")
}
if(!is.numeric(nshades)) {
stop("nshades needs to be a number")
}
# If colormap is a vector of hex strings, convert it to a format that the function expects
if(inherits(colormap,'character') && length(colormap)>1) {
cols <- unlist(apply(col2rgb(sort(colormap)),2,
function(x)list(rgb=c(x[[1]],x[[2]],x[[3]]))),
recursive = F)
colIndx <- c(0,(getIndexes(100,length(colormap))/100)[-1])
colormap <- mapply(function(a,b)list(index=a,rgb=b),colIndx,cols,
SIMPLIFY = F)
}
initV8()
# The Javascript lib doesn't do a good job picking out a small number of colors.
# So we generate a large number of colors and sample accordingly.
# this ensures a evenly distributed color palette over the entire range.
minshades <- max(nshades,256)
# Over to V8 + colormap JS.
val <- ct$call('colormap',list(colormap=colormap,nshades=minshades,
format=format,alpha=alpha))
#Pick only required number of colors
if(nshades<minshades){
val <- switch(format,
"hex" = val[getIndexes(minshades, nshades)],
"rgb" = val[getIndexes(minshades, nshades),],
"rgbaString" = val[getIndexes(minshades, nshades)])
}
# for hex format add Alpha to the end of each color bcoz the JS function doesn't.
if(format=='hex') {
val <- stringr::str_c(val ,as.character.hexmode(255*alpha))
}
if(reverse) {
rev(val)
} else {
val
}
}
initV8 <- function() {
if(is.null(ct)) {
ct <<- V8::v8()
ct$source(system.file("js/colormap.js", package="colormap"))
}
}
.onLoad <- function(libname, pkgname) {
initV8()
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.