-
Notifications
You must be signed in to change notification settings - Fork 0
/
tmrtools.R
151 lines (123 loc) · 5.05 KB
/
tmrtools.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
# tmrtools.R
# functions from tmrtools, until we figure out how to make it work with
# shinyapps.io
# Define RSG color palette
rsg_colors =
rbindlist(
list(
data.table(section = 'primary', name = 'darkgrey', r = 72, g = 72, b = 74),
data.table('primary', 'orange', 246, 139, 31),
data.table('secondary', 'marine', 0, 111, 161),
data.table('secondary', 'sky', 117, 190, 233),
data.table('secondary', 'leaf', 99, 175, 94),
data.table('secondary', 'sunshine', 255, 194, 14),
data.table('secondary', 'cherry', 186, 18, 34),
data.table('secondary', 'violet', 82, 77, 133),
data.table('greys', 'storm', 119, 120, 123),
data.table('greys', 'fog', 177, 179, 182),
data.table('greys', 'mist', 220, 221, 222)),
use.names=FALSE)
rgb2hex = function(r,g,b) rgb(r, g, b, maxColorValue = 255)
rsg_colors[, hex := rgb2hex(r, g, b)]
#' Get hexcodes for RSG colors
#'
#' Gets the color values for the current RSG color palette
#'
#' @param colors An optional vector of color names desired. Possible values
#' are darkgrey, orange, marine, sky, leaf, sunshine, cherry, violet, storm,
#' fog, mist. If no colors are specified all are returned.
#' @param dataframe Should function return a data frame of colors with names,
#' rgb values and hexcodes? If FALSE (default), a named vector is returned.
#' @return a named vector of hexcodes for the requested colors or a dataframe of colors.
#' @seealso [get_rsg_palette()]
#' @author matt.landis@@rsginc.com
#' @references TODO: Add location of current RSG palette
#' @examples
#' \dontrun{
#' get_rsg_colors()
#' get_rsg_colors(c('orange', 'marine'))}
#'
get_rsg_colors = function(colors = NULL, dataframe=FALSE){
if (is.null(colors)) {
colors = rsg_colors[, name]
}
if ( dataframe ){
output = rsg_colors[name %in% colors]
} else {
output = rsg_colors[name %in% colors, hex]
names(output) = rsg_colors[name %in% colors, name]
}
return(output)
}
#' Get RSG color palette
#'
#' Gets a named RSG color palette as a vector of named hexcodes
#'
#' @param palette The name of an RSG color palette. Possible values are
#' qualitative, primary (aka main), secondary, greys (aka grays), cool, hot,
#' spectrum (aka mixed).
#' @param reverse Logical. Should the order of colors be reversed?
#' @return a named vector of hexcodes for the requested palette
#' @seealso [get_rsg_colors()]
#' @author matt.landis@@rsginc.com
#' @examples
#' get_rsg_palette('qualitative', reverse=TRUE)
#'
get_rsg_palette = function(palette, reverse=FALSE){
color_names = switch(
palette,
qualitative = c('orange', 'sky', 'cherry', 'mist', 'darkgrey', 'leaf', 'violet', 'sunshine', 'fog'),
primary = rsg_colors[section %in% 'primary', name],
main = rsg_colors[section %in% 'primary', name],
secondary = rsg_colors[section %in% 'secondary', name],
greys = rsg_colors[section %in% 'greys', name],
grays = rsg_colors[section %in% 'greys', name],
cool = c('leaf', 'sky', 'violet'),
hot = c('sunshine', 'cherry', 'violet'),
mixed = c('sky', 'leaf', 'sunshine', 'orange', 'cherry'),
spectrum = c('sky', 'leaf', 'sunshine', 'orange', 'cherry')
)
# Make sure the order of the colors is correct
colors = get_rsg_colors(color_names)
pal = colors[color_names]
if (reverse) pal <- rev(pal)
return(pal)
}
# For use with ggplot2 ---------------------------------------------------------------
#' RSG colors with ggplot2
#'
#' Functions to use RSG colors with ggplot2. These functions were written based on
#' the examples shown \href{https://drsimonj.svbtle.com/creating-corporate-colour-palettes-for-ggplot2}{here}
#' @param palette the name of the palette to use. See \code{\link{get_rsg_palette}}
#' for allowed names.
#' @param discrete Logical. Should the scale be considered discrete (TRUE) or continuous (FALSE)?
#' @param ... Additional arguments passed to \code{\link[ggplot2]{scale_fill_gradientn}} or
#' \code{\link[ggplot2]{discrete_scale}} when \code{interpolate} is \code{TRUE} or \code{FALSE}
#' respectively.
#' @return Returns colors for ggplot graphic
#' @author joe.amoroso@@rsginc.com and matt.landis@@rsginc.com
#' @seealso [get_rsg_palette()], [get_rsg_colors()]
#' @name scale_color_rsg
NULL
#' @rdname scale_color_rsg
scale_color_rsg <- function(palette="qualitative", discrete=TRUE, reverse=FALSE, ...) {
aesthetic = 'color'
pal <- get_rsg_palette(palette = palette, reverse = reverse)
pal <- colorRampPalette(pal)
if (!discrete & palette != 'qualitative') {
scale_color_gradientn(colours = pal(256), ...)
} else {
discrete_scale(aesthetic, paste0("rsg_", palette), palette = pal, ...)
}
}
#' @rdname scale_color_rsg
scale_fill_rsg <- function(palette="qualitative", discrete=TRUE, reverse=FALSE, ...) {
aesthetic = 'fill'
pal <- get_rsg_palette(palette = palette, reverse = reverse)
pal <- colorRampPalette(pal)
if (!discrete & palette != 'qualitative') {
scale_fill_gradientn(colours = pal(256), ...)
} else {
discrete_scale(aesthetic, paste0("rsg_", palette), palette = pal, ...)
}
}