Skip to content

Instantly share code, notes, and snippets.

@mokztk

mokztk/cud_colors.R

Created August 1, 2022 00:57
Show Gist options
  • Save mokztk/2dae18e44d20e7bf5e96de7e3f19ff30 to your computer and use it in GitHub Desktop.
Save mokztk/2dae18e44d20e7bf5e96de7e3f19ff30 to your computer and use it in GitHub Desktop.
Download ZIP
カラーユニバーサルデザイン推奨配色セット ver.4 を R で使えるようにする
Raw
cud_colors.R
#=========================================================================================
# CUD (Color Universal Design) 推奨カラーパレット を R で使えるようにする
# ref: http://www2.cudo.jp/wp/?page_id=1565
#=========================================================================================
# カラーユニバーサルデザイン推奨配色セット ver.4（画面用RGB）
# 制作：カラーユニバーサルデザイン推奨配色セット製作委員会
cud_colors <- list()
# アクセントカラー
cud_colors$accent <- 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)
)
# ベースカラー
cud_colors$base <- list(
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)
)
# 無彩色
cud_colors$colorless <- list(
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_colors <- c(cud_colors,
with(cud_colors, c(accent, base, colorless)))
# パレット関数
# 「比較的見分けやすい組み合わせ」をパレットとして使用できるようにする
# 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 <- unname(unlist(cud_colors)[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 Aug 1, 2022 •
edited

Usage:

> devtools::source_gist("2dae18e44d20e7bf5e96de7e3f19ff30")
or
> devtools::source_gist("2dae18e44d20e7bf5e96de7e3f19ff30", sha1 = "19e686e")

Objects:

  • cud_colors (list) : 色名と #RRGGBB の対応
  • cud_pal (function) : 画面用「比較的見分けやすい組み合わせ」で示されている組み合わせをパレットとして使用

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