Skip to content

Commit acfd44a

Browse files
committed
- add braces around if-elses
- use `is.null()` and `NULL` default instead of `missing()` to make interactive testing easier - refactor full_level_name to use a look-up table and get vectorization for free
1 parent 50f9798 commit acfd44a

File tree

1 file changed

+33
-17
lines changed

1 file changed

+33
-17
lines changed

R/bayesplot-colors.R

Lines changed: 33 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -187,9 +187,10 @@ plot.bayesplot_scheme <- function(x, ...) {
187187

188188
#' @rdname bayesplot-colors
189189
#' @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){
192192
return(plot_scheme(scheme))
193+
}
193194

194195
bayesplot_grid(
195196
plots = lapply(scheme, plot_scheme),
@@ -203,18 +204,24 @@ color_scheme_view <- function(scheme) {
203204

204205
# plot color scheme
205206
# @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+
}
209215

210216
color_data <- data.frame(
217+
name = x_name,
211218
group = factor(names(x), levels = rev(names(x))),
212219
value = rep(1, length(x))
213220
)
214221
ggplot(
215222
color_data,
216223
aes_(
217-
x = if (missing(scheme)) "" else factor(scheme),
224+
x = ~ name,
218225
y = ~ value,
219226
fill = ~ group
220227
)
@@ -261,7 +268,7 @@ scheme_from_string <- function(scheme) {
261268
# user specified a ColorBrewer scheme (e.g., "brewer-Blues")
262269
if (!requireNamespace("RColorBrewer", quietly = TRUE)) {
263270
stop("Please install the 'RColorBrewer' package to use a ColorBrewer scheme.",
264-
call.=FALSE)
271+
call. = FALSE)
265272
}
266273
clrs <- RColorBrewer::brewer.pal(n = 6, name = gsub("brewer-", "", scheme))
267274
x <- setNames(as.list(clrs), scheme_level_names())
@@ -287,7 +294,7 @@ mixed_scheme <- function(scheme1, scheme2) {
287294
scheme2$dark_highlight
288295
))
289296
attr(scheme, "mixed") <- TRUE
290-
return(scheme)
297+
scheme
291298
}
292299

293300
#' Check if object returned by color_scheme_get() is a mixed scheme
@@ -307,20 +314,28 @@ is_mixed_scheme <- function(x) {
307314
#' @return A character vector of color values.
308315
#'
309316
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)
313318
stopifnot(all(levels %in% scheme_level_names()))
314319
color_vals <- color_scheme_get()[levels]
315320
unlist(color_vals, use.names = FALSE)
316321
}
317322

318323
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])
324339
}
325340

326341
# Custom color scheme if 6 colors specified
@@ -352,8 +367,9 @@ prepare_custom_colors <- function(scheme) {
352367
}
353368

354369
is_hex_color <- function(x) {
355-
if (!identical(substr(x, 1, 1), "#"))
370+
if (!identical(substr(x, 1, 1), "#")) {
356371
return(FALSE)
372+
}
357373
isTRUE(nchar(x) == 7)
358374
}
359375

0 commit comments

Comments
 (0)