Skip to content

Instantly share code, notes, and snippets.

@mokztk

mokztk/cud_colors_2.R

Created June 29, 2023 06:57
Show Gist options
  • Save mokztk/51fad874cf316f182c243c1cfbb25686 to your computer and use it in GitHub Desktop.
Save mokztk/51fad874cf316f182c243c1cfbb25686 to your computer and use it in GitHub Desktop.
Download ZIP
CUD (Color Universal Design) 推奨カラーパレット を R で使えるようにする Rev.2
Raw
cud_colors_2.R
#=========================================================================================
# CUD (Color Universal Design) 推奨カラーパレット を R で使えるようにする
# ref: http://www2.cudo.jp/wp/?page_id=1565
# カラーユニバーサルデザイン推奨配色セット ver.4（画面用RGB）
# 制作：カラーユニバーサルデザイン推奨配色セット製作委員会
#=========================================================================================
.list_cud_cols <- list(
# アクセントカラー
red = rgb(255, 75, 0, maxColorValue = 255),
yellow = rgb(255, 241, 0, maxColorValue = 255),
green = rgb( 3, 175, 122, maxColorValue = 255),
blue = rgb( 0, 90, 255, maxColorValue = 255),
skyblue = rgb( 77, 196, 255, maxColorValue = 255),
pink = rgb(255, 128, 130, maxColorValue = 255),
orange = rgb(246, 170, 0, maxColorValue = 255),
purple = rgb(153, 0, 153, maxColorValue = 255),
brown = rgb(128, 64, 0, maxColorValue = 255),
# ベースカラー
lightpink = rgb(255, 202, 191, maxColorValue = 255),
cream = rgb(255, 255, 128, maxColorValue = 255),
lightyellowgreen = rgb(216, 242, 85, maxColorValue = 255),
lightskyblue = rgb(191, 228, 255, maxColorValue = 255),
beige = rgb(255, 202, 128, maxColorValue = 255),
lightgreen = rgb(119, 217, 168, maxColorValue = 255),
lightpurple = rgb(201, 172, 230, maxColorValue = 255),
# 無彩色
white = rgb(255, 255, 255, maxColorValue = 255),
lightgray = rgb(200, 200, 203, maxColorValue = 255),
lightgrey = rgb(200, 200, 203, maxColorValue = 255),
gray = rgb(132, 145, 158, maxColorValue = 255),
grey = rgb(132, 145, 158, maxColorValue = 255),
black = rgb( 0, 0, 0, maxColorValue = 255)
)
# カラーコードの取得
cud_color <- function(colname) {
# colname はベクトルでも対応できるようにする
res <- sapply(colname,
function(x) {
n <- match(tolower(x), names(.list_cud_cols))
# 存在しない色名の場合はメッセージ＋NAを返す
if (is.na(n)) {
message(paste("undefined color name :", x))
return(NA_character_)
} else {
unlist(.list_cud_cols[x])
}
})
return(unname(res))
}
# パレット関数
# 「比較的見分けやすい組み合わせ」をパレットとして使用できるようにする
# parameters:
# type 色の種類（デフォルトは「アクセントカラー」）
# size 色数（デフォルトは 6）
# pal 組み合わせの番号（デフォルトは 1）
# direction 逆順にするときは -1
# warn 不適当なパラメーターについてデフォルトに変更するときに警告する
cud_pal <- function(type = "accent", size = 6, pal = 1, direction = 1, warn = TRUE) {
# エラー処理
if (!(type %in% c("a", "accent", "b", "base", "accent_base", "ab"))) {
stop(
paste(type,
"is not available.\n 'type' must be one of:",
"'accent' (or 'a', default), 'base' (or 'b'), 'accent_base' (or 'ab').")
)
} else {
type <- ifelse(type == "accent_base" | type == "ab", "ab", substr(type, 1, 1))
}
size <- as.numeric(size)
if (is.na(size)) stop("'size' must be a number. ")
pal <- as.numeric(pal)
if (is.na(pal)) stop("'pal' must be a number.")
direction <- ifelse(as.numeric(direction) == -1, -1, 1)
# 色の組み合わせ
# size や pal で指定したものがない場合は、デフォルトの値を使用する
cols <- NULL
cols <- switch(type,
"a" = switch(as.character(size),
"4" = switch(as.character(pal),
"1" = c("red", "yellow", "green", "skyblue"),
"2" = c("red", "yellow", "blue", "skyblue"),
"3" = c("red", "green", "blue", "skyblue"),
"4" = c("orange", "yellow", "purple", "skyblue"),
"5" = c("orange", "green", "purple", "skyblue"),
"6" = c("yellow", "purple", "skyblue", "pink"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("red", "yellow", "green", "skyblue")
}),
"5" = switch(as.character(pal),
"1" = c("red", "yellow", "green", "blue", "skyblue"),
"2" = c("orange", "yellow", "green", "skyblue", "purple"),
"3" = c("orange", "yellow", "green", "skyblue", "brown"),
"4" = c("orange", "yellow", "blue", "skyblue", "brown"),
"5" = c("yellow", "blue", "pink", "skyblue", "brown"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("red", "yellow", "green", "blue", "skyblue")
}),
"6" = switch(as.character(pal),
"1" = c("orange", "yellow", "green", "blue", "skyblue", "brown"),
"2" = c("red", "orange", "yellow", "green", "blue", "skyblue"),
"3" = c("red", "orange", "yellow", "green", "purple", "skyblue"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("orange", "yellow", "green", "blue", "skyblue", "brown")
}),
{
if (warn) warning(
paste0("'size = ", size, "' is invalid. Default (6) will be used.")
)
switch(as.character(pal),
"1" = c("orange", "yellow", "green", "blue", "skyblue", "brown"),
"2" = c("red", "orange", "yellow", "green", "blue", "skyblue"),
"3" = c("red", "orange", "yellow", "green", "purple", "skyblue"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("orange", "yellow", "green", "blue", "skyblue", "brown")
})
}),
"b" = switch(as.character(size),
"3" = switch(as.character(pal),
"1" = c("lightpink", "cream", "lightskyblue"),
"2" = c("lightpink", "cream", "lightpurple"),
"3" = c("cream", "lightgreen", "lightskyblue"),
"4" = c("cream", "beige", "lightskyblue"),
"5" = c("cream", "beige", "lightpurple"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("lightpink", "cream", "lightskyblue")
}),
"4" = switch(as.character(pal),
"1" = c("lightpink", "cream", "lightskyblue", "lightpurple"),
"2" = c("beige", "cream", "lightskyblue", "lightpurple"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("lightpink", "cream", "lightskyblue", "lightpurple")
}),
{
if (warn) warning(
paste0("'size = ", size, "' is invalid. Default (4) will be used.")
)
switch(as.character(pal),
"1" = c("lightpink", "cream", "lightskyblue", "lightpurple"),
"2" = c("beige", "cream", "lightskyblue", "lightpurple"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("lightpink", "cream", "lightskyblue", "lightpurple")
})
}),
"ab" = switch(as.character(pal),
"1" = c("orange", "yellow", "blue", "brown", "lightgreen", "lightskyblue"),
"2" = c("orange", "green", "skyblue", "brown", "lightpink", "cream"),
"3" = c("orange", "green", "brown", "lightpink", "cream", "lightskyblue"),
"4" = c("orange", "green", "brown", "lightpink", "cream", "lightpurple"),
"5" = c("orange", "blue", "skyblue", "brown", "lightpink", "cream"),
"6" = c("orange", "blue", "brown", "lightpink", "cream", "lightskyblue"),
"7" = c("orange", "blue", "brown", "lightpink", "cream", "lightpurple"),
"8" = c("orange", "blue", "brown", "cream", "lightgreen", "lightskyblue"),
{
if (warn) warning(
paste0("'pal = ", pal, "' is invalid. Default (1) will be used.")
)
c("orange", "yellow", "blue", "brown", "lightgreen", "lightskyblue")
})
)
# fail-safe
# 何らかの理由で cols が NULL のままだった場合は、デフォルトのパレット（アクセント6色の1番目）を返す
if (is.null(cols)) {
cols <- c("orange", "yellow", "green", "blue", "skyblue", "brown")
}
# パレットとして働くclosuerの作成
if (direction == -1) cols <- rev(cols)
size <- length(cols)
codes <- cud_color(cols)
function(n = size) {
n <- as.numeric(n)
if (is.na(n)) stop("'n' must be a number. ")
# 要求された色の数に足りない場合は、パレットを繰り返して使用する
if (n > size) {
if (warn) warning(
paste0("Requested colors (", n, ") > this palette (", size, " colors). ",
"The palette will be used repeatedly.")
)
codes <- rep(codes, length.out = n)
}
return(codes[1:n])
}
}
@mokztk
Copy link
Author

mokztk commented Jun 29, 2023 •
edited

Usage :

> devtools::source_gist("51fad874cf316f182c243c1cfbb25686")
or
> devtools::source_gist("51fad874cf316f182c243c1cfbb25686", sha1 = "c25bc4d")

Functions :

  • cud_color(colname) :
    CUD推奨カラーパレットの色名からカラーコードを取得。存在しない色は NA を返す
  • cud_pal(type = "accent", size = 6, pal = 1, direction = 1, warn = TRUE) :
    「比較的見分けやすい組み合わせ」をパレットとして使用する。デフォルトはアクセントカラー 6色のひとつ
    色が足りない場合は警告メッセージ（warn =F でoff可）を出してループで使用
> cud_color("red")
[1] "#FF4B00"
> cud_color(c("red", "blue", "magenta", "purple"))
undefined color name : magenta
[1] "#FF4B00" "#005AFF" NA        "#990099"
> 
> cud_pal()()
[1] "#F6AA00" "#FFF100" "#03AF7A" "#005AFF" "#4DC4FF" "#804000"
> cud_pal(type = "a", size = 5, pal = 2, direction = -1)()
[1] "#990099" "#4DC4FF" "#03AF7A" "#FFF100" "#F6AA00"
> cud_pal(type = "a", size = 5, pal = 2, direction = -1)(6)
[1] "#990099" "#4DC4FF" "#03AF7A" "#FFF100" "#F6AA00" "#990099"
 警告メッセージ: 
 cud_pal(type = "a", size = 5, pal = 2, direction = -1)(6) で: 
  Requested colors (6) > this palette (5 colors). The palette will be used repeatedly.
> cud_pal(type = "a", size = 5, pal = 2, direction = -1, warn = FALSE)(6)
[1] "#990099" "#4DC4FF" "#03AF7A" "#FFF100" "#F6AA00" "#990099"

@mokztk
Copy link
Author

mokztk commented Jun 29, 2023

cud_colors_2

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment