R/hermitage.R

In evpatora/hermitage: Create versatile palettes inspired by colors of art collection of L'ermitage/Hermitage museum in St. Petersburg, Russia

#' Complete list of palettes
#'
#' Use \code{\link{hermitage_palette}} to define palettes of needed size/length
#'
#' @export
hermitage_palettes <- list(
  collioure_matisse = c("#d08886", "#635579", "#7181b5", "#e2a34f", "#274743",
                        "#961e44", "#3a7479", "#35523e", "#1e1f5a"),
  peacock_clock = c("#deb24f", "#937749", "#554129", "#8692bc", "#9db5e4",
                    "#350816", "#710525", "#8d2140"),
  prodigal_son = c("#a25c22", "#1c130b", "#46240f", "#cc9c57", "#897446",
                   "#9e330b", "#534423", "#2e2624"),
  harmony = c("#dc9e79", "#223338", "#7c6b7a", "#9a684e", "#4a2430",
                     "#465aa2", "#a9243b", "#7d1831", "#784158"),
  dance_matisse = c("#2c3941", "#a73b39", "#743136", "#3d4a67", "#2e5e51"),
  judith = c("#a14134", "#809082", "#3d5154", "#2f434d"),
  magdalene_titian = c("#04204b", "#233758", "#946d46", "#debf92", "#a75231",
                       "#9d8f93"),
  bagration = c("#26211e", "#b77230", "#6e4323", "#3e5858", "#5c7075",
                "#85856e"),
  flight_gauguin = c("#aabdbb", "#a88878", "#778a87", "#8393b8", "#4d6189",
                     "#796159", "#3c4866", "#4d6364", "#96af7c"),
  hermitage_1 = c("#496f6f", "#1d6d60", "#43836d", "#30967e", "#53a797",
                  "#81beab", "#aed2df", "#6aaede", "#8d611f", "#605954"),
  hermitage_2 = c("#803721", "#815715", "#52250d", "#3c5c46"),
  madonna_litta = c( "#a73f33", "#c1ac97", "#1c1412", "#815845", "#51352b",
                     "#4c4c6b", "#5b5f83", "#777aa1", "#8184ad", "#9799b8"),
  cottages_vincent = c("#3f2318", "#686654", "#584331", "#b3b9c3", "#89916f",
                       "#8c7266", "#8f8124", "#cbc165", "#445c37", "#c46e3d",
                       "#e8614d", "#7d5b7a"),
  danae = c("#85412c", "#3b0409", "#bda062", "#233c44", "#465b5c",
            "#808176"),
  battista_cima = c("#273a42", "#897150", "#30351f", "#6f2d2d", "#ad615b",
                    "#133977", "#142c56", "#546787", "#636944", "#7e524c"),
  weyden = c("#803b1d", "#321a10", "#473720", "#424647", "#c8b37e",
             "#aa774f"),
  faberge = c("#d892a1", "#a36f6e", "#572636", "#9bacc0", "#85a79d",
              "#a8c7bf", "#d3941d"),
  parsons_1 = c("#602F6B", "#00cdcd", "#7A0646", "#FFD700", "#eae0c8",
                "#6a6c3b","#93fe51", "#003050", "#845860", "#eedd82",
                "#FFD04F", "#f06b5c", "#722F37", "#eaa6b2", "#B2F3AC",
                "#EDAC6E", "#bcd4e6", "#eac14f", "#92a1cf", "#f2efe6",
                "#29324f", "#ffff99", "#0b1307", "#fc8eac", "#a2b2bd",
                "#f6c79e", "#FAD6A5", "#EBB6CB", "#B3CEFF", "#2f2323",
                "#940000", "#d73b3e", "#5C7C99", "#800F08", "#2a2f23",
                "#816aa2",  "#c14040", "#EADEB3", "#25b387", "#aa6c39",
                "#0BDA51", "#ffc87c", "#555D50", "#660c21", "#807059",
                "#0f52ba", "#ffe4c4", "#4fa985", "#D6E3B5", "#967bb6",
                "#3C3E3F", "#A83641", "#0d0d91", "#170e01","#f4bfc7",
                "#993c0e", "#d9dde3", "#DBF1FD", "#CDD8D9", "#4997d0",
                "#eba832", "#b8c6b5", "#fbc030", "#585442", "#0047ab",
                "#808080", "#d0aca4", "#F5E6EA", "#726D5A", "#DFDC87",
                "#6d9a9b", "#AC7D0C", "#e25822", "#00A36C", "#f5f5dc",
                "#c54b8c", "#62483C", "#697D58", "#21421e", "#3B6AA0",
                "#C0C0C0", "#273e2d", "#8F00FF", "#3A5F0B", "#1034a6",
                "#99adbe", "#e25822"),
  parsons_2 = c("#c3633a", "#e7a221", "#f8a992", "#eecb00", "#aca538",
                "#dfc0b4","#198dca", "#d28b5c", "#d1a9b2", "#4e7fc6",
                "#6a7dce", "#b2b529", "#e2c3ac", "#96c1ca", "#ebcfb7",
                "#718e7d", "#ff6333", "#6f6399", "#760A06", "#ee403b",
                "#feb0a1", "#f7ca00", "#b5abd1", "#9d5a98", "#c7d4c4",
                "#c9ba0d", "#dc8991", "#ffb500", "#4b8e74", "#975fae",
                "#fecf39", "#f7dcbc", "#fd3335", "#a7c7be", "#7b5266",
                "#c1806d", "#fbe2b6", "#ff7e6e", "#ff7b6d", "#ff7605",
                "#b491a9", "#78a472", "#cad0d8", "#ffae9a", "#fee253",
                "#68a8ab", "#26a883", "#7e7864", "#ac8b44", "#c1a66d",
                "#387e72", "#d74c9b", "#cf87c3", "#465cbf", "#a1d4c4",
                "#7a6f63", "#465cc0", "#f33565", "#e07437", "#bcccba",
                "#ccd3b8", "#e1d752", "#8ea286", "#e9874d", "#4c63a7",
                "#e24c42", "#367d6d", "#6d5999", "#fb98b0", "#696c5a",
                "#d6afc2", "#e1dbc9", "#dd8238", "#a7ba80", "#fbdbad",
                "#f4c700", "#fda65d", "#677d73", "#96c7b0", "#f93747",
                "#d28ba8", "#cbc9a9", "#c8be22", "#f7b327", "#9e4f48",
                "#f3cb72", "#becfc7", "#d9cdba", "#e8d452", "#63ae9b",
                "#91ab9e", "#dcb7a1", "#7aab98", "#9f6851", "#df182b",
                "#9498a0", "#b6bd99", "#fc5b46", "#903c53", "#d1bd96",
                "#cb9361", "#658755", "#ca393b", "#454932", "#3b7ca5",
                "#9a802f", "#99598b", "#a25a36", "#413b58", "#bcb0a0",
                "#b49382", "#3f2b4d", "#c1834c", "#4e659b", "#a19631",
                "#d15832", "#2f3f4c", "#4d5b3c", "#cd8500", "#ce2e26"
                ),
  du_barry = c("#ED7A9B", "#91d19f", "#cb4a60", "#9CCFC5"),
  delft_ware = c("#d77a61", "#5cab91", "#b04b21", "#1F305E"),
  imari = c("#b04b21", "#476399", "#798daf", "#ae8b68", "#4c5537",
            "#825561", "#a2868d"),
  duresco = c("#f3c65e", "#6b752f", "#e49a17", "#673c1b", "#d86218",
              "#a93318"),
  water_paint = c("#f1d1bf", "#eda478", "#b2bb8d", "#f5cf86", "#714747",
              "#a2a084", "#d9acad", "#afd3de", "#8eb180", "#15687a"),
  kunstnefarver = c("#ccc10b", "#c9332c",  "#952c39",  "#be9600",  "#c05031",
                    "#a7001b",  "#613032",  "#504443",  "#395155",  "#3b2d59",
                    "#006ba9",  "#006ba9",  "#00439c",  "#44ada4"),
  albers = c("#090b3f", "#1c1a00", "#2d0c44", "#003802", "#904e00",
             "#7b213c", "#a50000", "#a34b00", "#a11200"),
  klee = c("#32365a", "#536b50", "#ac6211", "#92261b",
             "#725d64")
)

#' Discover palette
#'
#' @param n Number of colours needed. The largest palettes are parsons_1 and parsons_2 inspired by Thomas Parsons's colour samples from the book "A Tint Of Historical colours" (1934) and include 87 colours and 120 colours, respectively.
#' du_barry (n=4), delft_ware (n=4), imari (n=7) palettes and several others are inspired by the book "The anatomy of colour" by Patrick Baty. Other palettes are inspired by art collection of Hermitage museum.
#'
#'
#' @param name Name of the palette. Options:
#'  \code{parsons_1}, \code{parsons_2},  \code{du_barry},
#'  \code{delft_ware}, \code{imari},  \code{collioure_matisse}, \code{peacock_clock},
#'  \code{prodigal_son},  \code{harmony} , \code{dance_matisse} ,
#'  \code{judith}, \code{magdalene_titian}, \code{bagration}, \code{flight_gauguin},
#'  \code{hermitage_1}, \code{hermitage_2}, \code{madonna_litta}, \code{cottages_vincent},
#' \code{danae}, \code{battista_cima}, \code{weyden}, \code{faberge},
#' \code{duresco}, \code{water_paint}, \code{kunstnefarver}, \code{klee}.
#' @param type Either "continuous" or "discrete".
#'
#' @importFrom graphics rgb rect par image text
#' @return A vector of colours
#' @export
#' @keywords colours
#' @examples
#' hermitage_palette("parsons_1")

#' @usage
#' hermitage_palette("parsons_2")
#' hermitage_palette("hermitage_1")
#' hermitage_palette("harmony", 5)
#' hermitage_palette("imari", 5)
#' hermitage_palette("du_barry", 3)
#' For more colours:
#' more_colours <- hermitage_palette(25, name = "imari", type = "continuous")
#' @format
#'
hermitage_palette <- function(name, n, type = c("discrete", "continuous")) {
  type <- match.arg(type)

  palette <- hermitage_palettes[[name]]
  if (is.null(palette))
    stop("Palette not found")

  if (missing(n)) {
    n <- length(palette)
  }

  if (type == "discrete" && n > length(palette)) {
    stop("Number of colours > than allowed by the palette")
  }

  if (type == "discrete" && n < length(palette)) {
    out <- sample(palette, n, replace = FALSE)
  }

  out <- switch(type,
                continuous = grDevices::colorRampPalette(palette)(n),
                discrete = palette[1:n]
  )
  structure(out, class = "palette", name = name)
}

#' @export
#' @importFrom graphics rect par image text
#' @importFrom grDevices rgb
print.palette <- function(x, ...) {
  n <- length(x)
  old <- par(mar = c(0.5, 0.5, 0.5, 0.5))
  on.exit(par(old))

  image(1:n, 1, as.matrix(1:n), col = x,
        ylab = "", xaxt = "n", yaxt = "n", bty = "n")

  rect(0, 0.9, n + 1, 1.1, col = rgb(1, 1, 1, 0.8), border = NA)
  text((n + 1) / 2, 1, labels = attr(x, "name"), cex = 1, family = "cursive")
}

#' example data: GDP dataset from https://ourworldindata.org/global-economic-inequality-introduction
"gdp"
#' example data: Access to basic education dataset from https://ourworldindata.org/children-not-in-school
"edu"