@@ -187,9 +187,10 @@ plot.bayesplot_scheme <- function(x, ...) {
187
187
188
188
# ' @rdname bayesplot-colors
189
189
# ' @export
190
- color_scheme_view <- function (scheme ) {
191
- if (missing (scheme ) || length(scheme ) == 1 )
190
+ color_scheme_view <- function (scheme = NULL ) {
191
+ if (is.null (scheme ) || length(scheme ) == 1 ){
192
192
return (plot_scheme(scheme ))
193
+ }
193
194
194
195
bayesplot_grid(
195
196
plots = lapply(scheme , plot_scheme ),
@@ -203,18 +204,24 @@ color_scheme_view <- function(scheme) {
203
204
204
205
# plot color scheme
205
206
# @param scheme A string (length 1) naming a scheme
206
- plot_scheme <- function (scheme ) {
207
- x <- if (missing(scheme ))
208
- color_scheme_get() else color_scheme_get(scheme )
207
+ plot_scheme <- function (scheme = NULL ) {
208
+ if (is.null(scheme )) {
209
+ x <- color_scheme_get()
210
+ x_name <- " "
211
+ } else {
212
+ x <- color_scheme_get(scheme )
213
+ x_name <- factor (scheme )
214
+ }
209
215
210
216
color_data <- data.frame (
217
+ name = x_name ,
211
218
group = factor (names(x ), levels = rev(names(x ))),
212
219
value = rep(1 , length(x ))
213
220
)
214
221
ggplot(
215
222
color_data ,
216
223
aes_(
217
- x = if (missing( scheme )) " " else factor ( scheme ) ,
224
+ x = ~ name ,
218
225
y = ~ value ,
219
226
fill = ~ group
220
227
)
@@ -261,7 +268,7 @@ scheme_from_string <- function(scheme) {
261
268
# user specified a ColorBrewer scheme (e.g., "brewer-Blues")
262
269
if (! requireNamespace(" RColorBrewer" , quietly = TRUE )) {
263
270
stop(" Please install the 'RColorBrewer' package to use a ColorBrewer scheme." ,
264
- call. = FALSE )
271
+ call. = FALSE )
265
272
}
266
273
clrs <- RColorBrewer :: brewer.pal(n = 6 , name = gsub(" brewer-" , " " , scheme ))
267
274
x <- setNames(as.list(clrs ), scheme_level_names())
@@ -287,7 +294,7 @@ mixed_scheme <- function(scheme1, scheme2) {
287
294
scheme2 $ dark_highlight
288
295
))
289
296
attr(scheme , " mixed" ) <- TRUE
290
- return ( scheme )
297
+ scheme
291
298
}
292
299
293
300
# ' Check if object returned by color_scheme_get() is a mixed scheme
@@ -307,20 +314,28 @@ is_mixed_scheme <- function(x) {
307
314
# ' @return A character vector of color values.
308
315
# '
309
316
get_color <- function (levels ) {
310
- sel <- which(! levels %in% scheme_level_names())
311
- if (length(sel ))
312
- levels [sel ] <- sapply(levels [sel ], full_level_name )
317
+ levels <- full_level_name(levels )
313
318
stopifnot(all(levels %in% scheme_level_names()))
314
319
color_vals <- color_scheme_get()[levels ]
315
320
unlist(color_vals , use.names = FALSE )
316
321
}
317
322
318
323
full_level_name <- function (x ) {
319
- switch (x ,
320
- l = " light" , lh = " light_highlight" ,
321
- m = " mid" , mh = " mid_highlight" ,
322
- d = " dark" , dh = " dark_highlight"
323
- )
324
+ map <- c(
325
+ l = " light" ,
326
+ lh = " light_highlight" ,
327
+ m = " mid" ,
328
+ mh = " mid_highlight" ,
329
+ d = " dark" ,
330
+ dh = " dark_highlight" ,
331
+ light = " light" ,
332
+ light_highlight = " light_highlight" ,
333
+ mid = " mid" ,
334
+ mid_highlight = " mid_highlight" ,
335
+ dark = " dark" ,
336
+ dark_highlight = " dark_highlight"
337
+ )
338
+ unname(map [x ])
324
339
}
325
340
326
341
# Custom color scheme if 6 colors specified
@@ -352,8 +367,9 @@ prepare_custom_colors <- function(scheme) {
352
367
}
353
368
354
369
is_hex_color <- function (x ) {
355
- if (! identical(substr(x , 1 , 1 ), " #" ))
370
+ if (! identical(substr(x , 1 , 1 ), " #" )) {
356
371
return (FALSE )
372
+ }
357
373
isTRUE(nchar(x ) == 7 )
358
374
}
359
375
0 commit comments