|
| 1 | +### Load packages |
| 2 | +#' @import colorspace |
| 3 | +#' @import purrr |
| 4 | +#' @import grDevices |
| 5 | + |
| 6 | +# Load internal data |
| 7 | +load(file = "R/sysdata.rda") |
| 8 | + |
| 9 | +# Create hex code matrix |
| 10 | +fullhexpallette <- matrix(sydneyunicolours$hex) |
| 11 | +rownames(fullhexpallette) <- sydneyunicolours$colourName |
| 12 | + |
| 13 | +#' University branding colours |
| 14 | +#' |
| 15 | +usydSwatchplot <- colorspace::swatchplot(fullhexpallette) |
| 16 | + |
| 17 | +# Create colour list |
| 18 | +colourList <- as.character(sydneyunicolours[["hex"]]) |
| 19 | +names(colourList) <- sydneyunicolours$colourName |
| 20 | + |
| 21 | +#' Function to call hex codes from colourList |
| 22 | +#' |
| 23 | +#' @param ... a list of colour names from colourList |
| 24 | +#' @return A list of hex codes corresponding to the chosen colours |
| 25 | +usyd_cols <- function(...) { |
| 26 | + cols <- c(...) |
| 27 | + if (is.null(cols)) |
| 28 | + return (colourList) |
| 29 | + colourList[cols] |
| 30 | +} |
| 31 | + |
| 32 | +#' Complete list of USYD colour palettes |
| 33 | +#' |
| 34 | +#' @export |
| 35 | +usyd_palettes <- list( |
| 36 | + `primary` = usyd_cols("MasterbrandCharcoal", "MasterbrandOchre", "AccentBlue", "AccentYellow", "AccentGrey"), |
| 37 | + `extended` = usyd_cols("MasterbrandCharcoal", "MasterbrandOchre", "AccentBlue", "AccentYellow", "SecondaryDarkGreen", |
| 38 | + "SecondaryBlue", "SecondaryPeach", "SecondaryBeige", "SecondaryLemon", "SecondaryLightGreen", |
| 39 | + "SecondaryDarkSeafoam", "SecondaryLightSeafoam", "SecondaryLightBlue", "SecondaryLilac", |
| 40 | + "SecondaryPurple", "SecondaryPink", "SecondaryLightPink", "SecondaryOrange", "SecondaryMaroon", |
| 41 | + "MasterbrandBlack", "AccentGrey"), |
| 42 | + `secondary` = usyd_cols("MasterbrandOchre", "SecondaryBlue", "AccentYellow", "SecondaryDarkSeafoam", "SecondaryLilac"), |
| 43 | + `pastel` = usyd_cols("SecondaryLemon", "SecondaryPeach", "SecondaryLightPink", "SecondaryLilac", "SecondaryLightBlue", "SecondaryLightSeafoam", "SecondaryLightGreen"), |
| 44 | + `complementary_ReGr` = usyd_cols("MasterbrandOchre", "SecondaryPeach", "SecondaryMaroon", "SecondaryDarkSeafoam", "SecondaryLightSeafoam"), |
| 45 | + `complementary_ReBl` = usyd_cols("MasterbrandOchre", "SecondaryPeach", "SecondaryBeige", "AccentBlue", "SecondaryBlue", "SecondaryLightBlue"), |
| 46 | + `bright` = usyd_cols("MasterbrandOchre", "SecondaryDarkGreen", "SecondaryLightGreen", "SecondaryLightBlue", "SecondaryBlue", "SecondaryOrange", "AccentYellow"), |
| 47 | + `muted` = usyd_cols("SecondaryLightBlue", "SecondaryLemon", "SecondaryPeach"), |
| 48 | + `trafficlight` = usyd_cols("SecondaryDarkSeafoam", "SecondaryLemon", "MasterbrandOchre"), |
| 49 | + `heatmap` = usyd_cols("SecondaryDarkSeafoam", "MasterbrandWhite", "MasterbrandOchre"), |
| 50 | + `flametree` = usyd_cols("SecondaryLemon", "SecondaryOrange", "MasterbrandOchre", "SecondaryMaroon"), |
| 51 | + `jacaranda` = usyd_cols("SecondaryLightPink", "SecondaryLilac", "SecondaryBlue", "AccentBlue"), |
| 52 | + `harbour` = usyd_cols("SecondaryLightGreen", "SecondaryLightSeafoam", "SecondaryBlue", "AccentBlue"), |
| 53 | + `sandstone` = usyd_cols("SecondaryIvory", "SecondaryBeige", "SecondaryMaroon", "MasterbrandCharcoal"), |
| 54 | + `ochre` = usyd_cols("SecondaryIvory", "SecondaryBeige", "SecondaryPeach", "MasterbrandOchre"), |
| 55 | + `greyscale` = usyd_cols("MasterbrandCharcoal", "AccentGrey"), |
| 56 | + `BlGrYe` = usyd_cols("AccentBlue", "SecondaryLightGreen", "SecondaryLemon"), |
| 57 | + `BlOr` = usyd_cols("AccentBlue", "SecondaryOrange", "SecondaryLemon"), |
| 58 | + `diverging_blue_red` = usyd_cols("SecondaryMaroon", "MasterbrandOchre", "SecondaryPeach", "MasterbrandWhite", "SecondaryLightBlue", "SecondaryBlue", "AccentBlue"), |
| 59 | + `diverging_blue_orange` = usyd_cols("SecondaryOrange", "MasterbrandWhite", "AccentBlue") |
| 60 | +) |
| 61 | + |
| 62 | +#' Use purrr to remove the names of usyd_palettes |
| 63 | +#' |
| 64 | +usyd_palettes <- purrr::map2(usyd_palettes, usyd_palettes, unname) |
| 65 | + |
| 66 | + |
| 67 | +#' Return hex codes based on predefined palettes |
| 68 | +#' |
| 69 | +#' @param name Name of the desired palette (refer to documentation for options). All colours are from the University of Sydney Brand Guidelines document version 2.0. |
| 70 | +#' @param n The number of colours required. Most palettes support between 2 - 6 colours. The largest palette is \code{extended}, which contains 21 colours. |
| 71 | +#' @param type "Discrete" or "continuous". Discrete is recommended for most palettes, unless the number of colours required is less than the number of variables, in which case continuous may be selected. |
| 72 | +#' @export |
| 73 | +#' |
| 74 | +#' @examples |
| 75 | +#' usyd_palette('primary') |
| 76 | +#' usyd_palette('jacaranda') |
| 77 | +#' usyd_palette('extended', 20, type = 'continuous') |
| 78 | +usyd_palette <- function(name, n, type = c("discrete", "continuous")) { |
| 79 | + type <- match.arg(type) |
| 80 | + pal <- usyd_palettes[[name]] |
| 81 | + if (is.null(pal)) |
| 82 | + stop("Palette not found. Please submit a pull request if you'd like to contribute your palette to the collection.") |
| 83 | + if (missing(n)) { |
| 84 | + n <- length(pal) |
| 85 | + } |
| 86 | + if (type == "discrete" && n > length(pal)) { |
| 87 | + stop("Number of requested colors exceeds number in palette. Try again and specify 'n'.") |
| 88 | + } |
| 89 | + out <- switch(type, |
| 90 | + continuous = grDevices::colorRampPalette(pal)(n), |
| 91 | + discrete = pal[1:n] |
| 92 | + ) |
| 93 | + structure(out, class = "palette", name = name) |
| 94 | +} |
| 95 | + |
| 96 | + |
| 97 | + |
| 98 | + |
| 99 | +#' Generates new palettes based on colour selections |
| 100 | +#' |
| 101 | +#' @param ... Colour names from swatchplot (refer to documentation) |
| 102 | +#' @return A colour palette ready for use. |
| 103 | +#' @export |
| 104 | +#' @examples |
| 105 | +#' my_palette <- usyd_pal_gen("SecondaryDarkSeafoam", "SecondaryLightSeafoam", "AccentYellow") |
| 106 | +usyd_pal_gen <- function(...) { |
| 107 | + cols <- c(...) |
| 108 | + if (is.null(cols)) |
| 109 | + return (colourList) |
| 110 | + colourList2 <- colourList[cols] |
| 111 | + colourList2 <- unname(colourList2) |
| 112 | +} |
| 113 | + |
0 commit comments