# CREATE MANUAL COLOR SCHEME FOR A LIST
#' Create qualitative colours
#' @param n number of colors
#' @param light light colors TRUE or FALSE
#' @return list of n different colors
#' @source Modified based on https://gist.github.com/peterk87/6011397
#' @importFrom RColorBrewer brewer.pal
#' @examples
#' PhyloProfile:::qualitativeColours(5)
qualitativeColours <- function(n, light = FALSE) {
# For more than 21 colours needed
rich12equal <- c(
"#000040", "#000093", "#0020E9", "#0076FF", "#00B8C2", "#04E466",
"#49FB25", "#E7FD09", "#FEEA02", "#FFC200", "#FF8500", "#FF3300")
# Qualitative colour schemes by Paul Tol
ifelse (n >= 19 & n <= 21, return(grDevices::colorRampPalette(c(
"#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD",
"#117777", "#44AAAA", "#77CCCC", "#117744", "#44AA77", "#88CCAA",
"#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77",
"#771122", "#AA4455", "#DD7788"))(n)),
ifelse (n >= 16 & n <= 18, return(grDevices::colorRampPalette(c(
"#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD",
"#117777", "#44AAAA", "#77CCCC", "#777711", "#AAAA44", "#DDDD77",
"#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455",
"#DD7788"))(n)),
ifelse (n == 15, return(grDevices::colorRampPalette(c(
"#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA",
"#77AADD", "#117777", "#44AAAA", "#77CCCC", "#777711",
"#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77",
"#771122", "#AA4455", "#DD7788"))(n)),
ifelse(n > 12 & n <= 14, return(grDevices::colorRampPalette(c(
"#882E72", "#B178A6", "#D6C1DE", "#1965B0", "#5289C7",
"#7BAFDE", "#4EB265", "#90C987", "#CAE0AB", "#F7EE55",
"#F6C141", "#F1932D", "#E8601C", "#DC050C"))(n)),
ifelse(n > 9 & n <= 12,
ifelse(
light,
return(RColorBrewer::brewer.pal(
n = n, name = 'Set3')),
return(RColorBrewer::brewer.pal(
n = n, name = 'Paired'))),
ifelse(n <= 9,
ifelse(
light,
return(RColorBrewer::brewer.pal(
n = n, name = 'Pastel1')),
return(RColorBrewer::brewer.pal(
n = n, name = 'Set1'))),
return(grDevices::colorRampPalette(rich12equal)(n))
)
)
)
)
)
)
}
#' Get color for a list of items
#' @return list of colors for each element (same elements will have the same
#' color)
#' @param x input list
#' @export
#' @author Vinh Tran tran@bio.uni-frankfurt.de
#' @seealso \code{\link{qualitativeColours}}
#' @examples
#' items <- c("a", "b", "c")
#' getQualColForVector(items)
getQualColForVector <- function(x = NULL) {
if (is.null(x)) stop("Input list is NULL!")
types <- unique(x)
types <- types[!is.na(types)]
typeColors <- qualitativeColours(length(types))
colorsTypes <- as.vector(x)
countTypes <- countColors <- 1
while (countTypes <= length(types)) {
if (countColors > length(typeColors)) countColors <- 1
colorsTypes[colorsTypes == types[countTypes]] <- typeColors[countColors]
countColors <- countColors + 1
countTypes <- countTypes + 1
}
return(unlist(colorsTypes))
}
#' Check if a color pallete has enough colors for a list of items
#' @export
#' @param items vector contains list of items
#' @param pallete name of color palette
#' @return TRUE if color pallete has enough colors, otherwise FALSE
#' @author Vinh Tran tran@bio.uni-frankfurt.de
#' @importFrom RColorBrewer brewer.pal.info
#' @examples
#' myItems <- rep("a",3)
#' checkColorPallete(myItems, "Set1")
checkColorPallete <- function(items, pallete = "Paired") {
if (is.null(items)) stop("No item given!")
colorDf <- data.frame(RColorBrewer::brewer.pal.info)
if (!(pallete %in% row.names(colorDf)))
stop("Given color pallete not found")
colorDf$name <- row.names(colorDf)
if (length(items) < colorDf$maxcolors[colorDf$name == pallete])
return(TRUE)
return(FALSE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.