Я использую прикрепленный код R для создания пользовательской цветовой палитры в R, которая возвращает шестнадцатеричные значения в зависимости от количества уровней. Прикрепленный код работает отлично, но у меня возникают проблемы с пониманием того, как код понимает количество уровней во входном векторе. «N» - это аргумент в функции внутри функции (check_pal_n внутри create_pal), но «n» не является одним из аргументов, которые вы можете передать «create_pal».
Очевидно, код работает, но я хочучтобы лучше понять, как это работает. Любая помощь приветствуется!
library(tidyverse)
# create a labeled list of colors
custom_color_hexcodes <- c(
`blue` = "#002F6C",
`red` = "#BA0C2F",
`light blue` = "#A7C6ED",
`medium blue` = "#006789",
`dark red` = "#631032",
`web blue` = "#205493",
`rich black` = "#212721",
`dark grey` = "#6C6463",
`medium grey`= "#8C8983",
`light grey`= "#CFCDC9")
# wrap that list in a callable function
custom_cols <- function(...) {
cols <- c(...)
if (is.null(cols))
return (custom_color_hexcodes)
custom_color_hexcodes[cols]
}
# There are 10 colors, so our max number of colors will be 10.
check_pal_n <- function(n, max_n) {
if (n > max_n) {
warning("This palette can handle a maximum of ", max_n, " values.",
"You have supplied ", n, ".")
} else if (n < 0) {
stop("`n` must be a non-negative integer.")
}
}
custom_pal <- function(fill=TRUE){
colors <- custom_color_hexcodes
if (fill){
max_n <- 9
f <- function(n) {
check_pal_n(n, max_n)
if (n == 1L) {
i <- "blue"
} else if (n == 2L) {
i <- c("blue", "red")
} else if (n == 3L) {
i <- c("blue", "red", "light blue")
} else if (n == 4L) {
i <- c("blue", "red", "light blue", "dark red")
} else if (n %in% 5:6) {
## 20120901_woc904
i <- c("blue", "red", "light blue", "dark red",
"dark grey", "light grey")
} else if (n == 7L) {
# 20120818_AMC820
i <- c("blue", "red", "light blue", "dark red",
"dark grey", "light grey", "medium blue")
} else if (n >= 8L) {
# 20120915_EUC094
i <- c("blue", "red", "light blue", "dark red",
"dark grey", "light grey", "medium blue", "rich black")
}
unname(colors[i][seq_len(n)])
}
} else {
max_n <- 9
f <- function(n) {
check_pal_n(n, max_n)
if (n <= 3) {
i <- c("blue", "red", "light blue")
} else if (n %in% 4:5) {
# i <- c("blue", "red", "light blue", "dark red")
i <- c("blue", "red", "light blue", "dark red", "dark grey")
} else if (n == 6) {
# 20120825_IRC829
i <- c("blue", "red", "light blue", "dark red",
"dark grey", "light grey")
} else if (n > 6) {
# 20120825_IRC829
i <- c("blue", "red", "light blue", "dark red",
"dark grey", "light grey", "medium blue", "rich black",
"web blue", "medium grey")
}
unname(colors[i][seq_len(n)])
}
}
attr(f, "max_n") <- max_n
f
}
scale_colour <- function(...) {
discrete_scale("colour", "custom_cols", custom_pal(), ...)
}
scale_fill <- function(...) {
discrete_scale("fill", "custom_cols", custom_pal(), ...)
}