Nothing
####################################################################
#' Personal Colours Palette
#'
#' Fetch customizable palettes for the library's usage. The package has
#' its own default colour-blind friendly colours but can be customized using
#' R internal options (i.e. \code{options("lares.palette" = c("#FF8303" = "#000",
#' "#40A4D8" = "#FFF", ...))}. There are 3 options you can use to customize all
#' colour palletes: "lares.palette" (vector, will be used in the same order as passed,
#' and must have a counter colour defined), "lares.colours" (vector, simple colour
#' names and their HEX codes), and "lares.colours.custom" (data.frame, containing
#' "values" to use dynamically, "fill" for main colour, and "colour" (not obligatory)
#' for counter colour).
#'
#' @family Themes
#' @param return Character. Get only what you need. Select any of:
#' "all" or "list" (list),
#' "colors" or "colours" (vector),
#' "pal" or "palette" (named vector),
#' "simple" (named vector),
#' "custom" or "personal" (data.frame)
#' @return Depending on the \code{return} input, we get a:
#' \itemize{
#' \item \code{vector} with \code{palette} results vector
#' \item \code{vector} with \code{palette} results vector's names
#' \item \code{list} with \code{palette} results vector, \code{labels}
#' results data.frame, and \code{simple} results named vector
#' }
#' @examples
#' # Simple colour-named palette
#' lares_pal("simple")
#'
#' # Raw colours and counter-colours
#' # OR simply: lares_pal("palette")
#' nice_palette <- lares_pal("colours")
#' nice_palette_ctr <- as.vector(lares_pal()$palette)
#' lapply(list(nice_palette, nice_palette_ctr), head)
#'
#' # Personal colours by name
#' df <- lares_pal("custom")
#' df[sample(nrow(df), 5), ]
#' @export
lares_pal <- function(return = "list") {
# Generic colour and counter-colour palette
colours_names <- getOption("lares.palette")
if (length(unique(names(colours_names))) != length(colours_names)) {
stop("Check your lares.palette option. Do not repeat colours.")
}
if (!"character" %in% class(colours_names)) {
stop("Check your lares.palette option. Must be a character vector.")
}
# Specific (simple) colours by names
simple <- c(getOption("lares.colours"), getOption("lares.colors"))
if (length(unique(names(simple))) != length(simple)) {
stop("Check your lares.colours option. Do not repeat colours.")
}
if (!"character" %in% class(simple)) {
stop("Check your lares.colours option. Must be a character vector.")
}
# Personal colours list (add more with lares.colours.custom options)
colours_list <- data.frame(rbind(
c("m", simple[["blue"]], simple[["white"]]),
c("f", simple[["pink"]], simple[["black"]]),
c("male", simple[["blue"]], simple[["white"]]),
c("female", simple[["pink"]], simple[["black"]]),
c("hombre", simple[["blue"]], simple[["white"]]),
c("mujer", simple[["pink"]], simple[["black"]]),
c("true", simple[["green"]], simple[["white"]]),
c("false", simple[["red"]], simple[["black"]]),
c("TRUE", simple[["green"]], simple[["white"]]),
c("FALSE", simple[["red"]], simple[["black"]]),
c("1", simple[["green"]], simple[["white"]]),
c("0", simple[["red"]], simple[["black"]]),
c("-1", simple[["red"]], simple[["black"]]),
c("X", simple[["grey"]], simple[["black"]]),
c("good", "#59B3D2", simple[["white"]]),
c("bad", "#E5586E", simple[["black"]]),
c("aprueba", "#59B3D2", simple[["white"]]),
c("rechaza", "#E5586E", simple[["black"]]),
c("ns/nc", "#E5586E", simple[["grey"]]),
c("positive", "#59B3D2", simple[["black"]]),
c("negative", "#E5586E", simple[["black"]]),
c("bueno", "#59B3D2", simple[["white"]]),
c("malo", "#E5586E", simple[["black"]]),
c("spring", simple[["green"]], simple[["white"]]),
c("summer", simple[["red"]], simple[["white"]]),
c("fall", simple[["orange"]], simple[["black"]]),
c("winter", simple[["blue"]], simple[["black"]]),
c("meg1", "#071D49", simple[["white"]]),
c("meg2", "#EBB600", simple[["black"]]),
c("meg3", "#F2F1F0", simple[["black"]]),
c("meg4", "#9A9A9A", simple[["white"]]),
c("r5", "#290452", simple[["white"]]),
c("otro", simple[["grey"]], simple[["black"]]),
c("fear", "#810806", simple[["white"]]),
c("disgust", "#BF200E", simple[["black"]]),
c("anger", "#FE9B13", simple[["black"]]),
c("sadness", "#838B8B", simple[["black"]]),
c("anticipation", "#FE8A71", simple[["black"]]),
c("surprise", "#F7E565", simple[["black"]]),
c("trust", "#40A4D8", simple[["black"]]),
c("joy", "#BD116F", simple[["black"]]),
c("fb1", "#405996", simple[["white"]]),
c("fb2", "#7184B2", simple[["black"]]),
c("fb3", "#AFBEE3", simple[["black"]]),
c("facebook", "#4267B2", simple[["black"]]),
c("instagram", "#E95950", simple[["black"]]),
c("messenger", "#0084FF", simple[["black"]]),
c("whatsapp", "#4DC247", simple[["black"]])
))
colnames(colours_list) <- c("values", "fill", "colour")
more_cols <- getOption("lares.colours.custom")
if (length(more_cols) > 1) {
if (!"data.frame" %in% class(more_cols)) {
stop("Check your lares.colours.custom option. Must be a data.frame.")
}
if (!"colour" %in% colnames(more_cols)) more_cols$colour <- "#000"
if (!all(colnames(more_cols) %in% colnames(colours_list))) {
stop(
"Check your lares.colours.custom option. Column names must match: ",
v2t(colnames(colours_list))
)
}
colours_list <- colours_list %>%
filter(!.data$values %in% more_cols$values) %>%
bind_rows(more_cols)
}
pal <- list(
labels = colours_list,
palette = rep(colours_names, 4),
simple = simple
)
if (return %in% c("colors", "colours", "color", "colour", "raw", "col")) {
pal <- names(colours_names)
}
if (return %in% c("pal", "palette")) {
pal <- colours_names
}
if (return %in% c("personal", "custom", "labels")) {
pal <- colours_list
}
if (return %in% "simple") {
pal <- simple
}
structure(pal, class = "lares_pal")
attr("type", return)
return(pal)
}
####################################################################
#' Plot Palette Colours
#'
#' This function plots a list of colours
#'
#' @family Themes
#' @inheritParams cache_write
#' @param fill Vector. List of colours for fills.
#' @param colour Vector. List of colours for colours.
#' @param id Vector. ID for each color.
#' @param limit Integer. Show only first n values.
#' @return Plot with \code{fill} colours and \code{colour} counter-colours
#' if provided.
#' @examples
#' # Simply pass a vector
#' pal <- lares_pal("simple")
#' plot_palette(pal)
#' # Or fill + color named vector
#' pal <- lares_pal("pal")
#' plot_palette(fill = names(pal), colour = as.vector(pal))
#' @export
plot_palette <- function(fill, colour = "black", id = NA, limit = 12, ...) {
if (length(fill) > limit) {
fill <- fill[1:limit]
colour <- colour[1:limit]
colour <- colour[!is.na(colour)]
message(paste("Limited to", limit, "colours. Overwrite with 'limit' parameter"))
}
if (is.na(id[1])) id <- seq_along(fill)
p <- data.frame(fill = fill, colour = colour, id = id) %>%
distinct(.keep_all = TRUE) %>%
ggplot(aes(x = reorder(fill, -id), y = 1)) +
geom_bar(aes(fill = fill), stat = "identity", position = "dodge") +
geom_text(aes(colour = colour, label = id), hjust = 1.5) +
scale_fill_identity() +
scale_colour_identity() +
coord_flip() +
labs(x = NULL, y = NULL) +
guides(fill = "none", colour = "none") +
theme_lares(font = NA, axis = "Y", ...)
return(p)
}
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.