Google Git
Sign in
third-party-mirror / R / refs/heads/R-3-6-branch / . / src / library / grDevices / R / hcl.colors.R
blob: 9084d73762ce26fcfc80913a8d2f613f539cb045 [file] [log] [blame]
.hcl_colors_parameters <- as.data.frame(rbind(structure(numeric(0L), .Dim = c(0L, 16L), .Dimnames = list(NULL,
c("type", "h1", "h2", "h3", "c1", "c2", "c3", "l1", "l2", "l3", "p1", "p2", "p3", "p4", "cmax1", "cmax2"))),
"Pastel 1" = c(1, 0, NA, NA, 35, NA, NA, 85, NA, NA, NA, NA, NA, NA, NA, NA),
"Dark 2" = c( 1, 0, NA, NA, 50, NA, NA, 60, NA, NA, NA, NA, NA, NA, NA, NA),
"Dark 3" = c( 1, 0, NA, NA, 80, NA, NA, 60, NA, NA, NA, NA, NA, NA, NA, NA),
"Set 2" = c( 1, 0, NA, NA, 60, NA, NA, 70, NA, NA, NA, NA, NA, NA, NA, NA),
"Set 3" = c( 1, 10, NA, NA, 50, NA, NA, 80, NA, NA, NA, NA, NA, NA, NA, NA),
"Warm" = c( 1, 90, -30, NA, 50, NA, NA, 70, NA, NA, NA, NA, NA, NA, NA, NA),
"Cold" = c( 1, 270, 150, NA, 50, NA, NA, 70, NA, NA, NA, NA, NA, NA, NA, NA),
"Harmonic" = c( 1, 60, 240, NA, 50, NA, NA, 70, NA, NA, NA, NA, NA, NA, NA, NA),
"Dynamic" = c( 1, 30, NA, NA, 50, NA, NA, 70, NA, NA, NA, NA, NA, NA, NA, NA),
"Grays" = c( 2, 0, NA, NA, 0, NA, NA, 10, 98, NA, 1.3, NA, NA, NA, NA, NA),
"Light Grays" = c( 2, 0, NA, NA, 0, NA, NA, 30, 90, NA, 1.5, NA, NA, NA, NA, NA),
"Blues 2" = c( 2, 260, NA, NA, 80, NA, NA, 30, 90, NA, 1.5, NA, NA, NA, NA, NA),
"Blues 3" = c( 2, 245, NA, NA, 50, NA, NA, 20, 98, NA, 0.8, 1.4, NA, NA, 75, NA),
"Purples 2" = c( 2, 270, NA, NA, 70, NA, NA, 25, 95, NA, 1.2, NA, NA, NA, NA, NA),
"Purples 3" = c( 2, 270, NA, NA, 50, NA, NA, 20, 98, NA, 0.9, 1.4, NA, NA, 75, NA),
"Reds 2" = c( 2, 10, NA, NA, 85, NA, NA, 25, 95, NA, 1.3, NA, NA, NA, NA, NA),
"Reds 3" = c( 2, 10, NA, NA, 65, NA, NA, 20, 97, NA, 1.1, 1.3, NA, NA, 150, NA),
"Greens 2" = c( 2, 135, NA, NA, 45, NA, NA, 35, 95, NA, 1.3, NA, NA, NA, NA, NA),
"Greens 3" = c( 2, 135, NA, NA, 35, NA, NA, 25, 98, NA, 1, 1.5, NA, NA, 70, NA),
"Oslo" = c( 2, 250, NA, NA, 0, 0, NA, 99, 1, NA, 1, NA, NA, NA, 70, NA),
"Purple-Blue" = c( 2, 300, 200, NA, 60, 0, NA, 25, 95, NA, 0.7, 1.3, NA, NA, NA, NA),
"Red-Purple" = c( 2, 10, -80, NA, 80, 5, NA, 25, 95, NA, 0.7, 1.3, NA, NA, NA, NA),
"Red-Blue" = c( 2, 0, -100, NA, 80, 40, NA, 40, 75, NA, 1, 1, NA, NA, NA, NA),
"Purple-Orange" = c( 2, -83, 20, NA, 65, 18, NA, 32, 90, NA, 0.5, 1, NA, NA, NA, NA),
"Purple-Yellow" = c( 2, 320, 80, NA, 60, 20, NA, 30, 95, NA, 0.7, 1.3, NA, NA, 65, NA),
"Blue-Yellow" = c( 2, 265, 80, NA, 60, 10, NA, 25, 95, NA, 0.7, 2, NA, NA, NA, NA),
"Green-Yellow" = c( 2, 140, 80, NA, 50, 10, NA, 40, 97, NA, 0.7, 1.8, NA, NA, NA, NA),
"Red-Yellow" = c( 2, 10, 85, NA, 80, 10, NA, 25, 95, NA, 0.4, 1.3, NA, NA, NA, NA),
"Heat" = c( 2, 0, 90, NA, 80, 30, NA, 30, 90, NA, 0.2, 2, NA, NA, NA, NA),
"Heat 2" = c( 2, 0, 90, NA, 100, 30, NA, 50, 90, NA, 0.2, 1, NA, NA, NA, NA),
"Terrain" = c( 2, 130, 0, NA, 80, 0, NA, 60, 95, NA, 0.1, 1, NA, NA, NA, NA),
"Terrain 2" = c( 2, 130, 30, NA, 65, 0, NA, 45, 90, NA, 0.5, 1.5, NA, NA, NA, NA),
"Viridis" = c( 2, 300, 75, NA, 40, 95, NA, 15, 90, NA, 1, 1.1, NA, NA, NA, NA),
"Plasma" = c( 2, -100, 100, NA, 60, 100, NA, 15, 95, NA, 2, 0.9, NA, NA, NA, NA),
"Inferno" = c( 2, -100, 85, NA, 0, 65, NA, 1, 98, NA, 1.1, 0.9, NA, NA, 120, NA),
"Dark Mint" = c( 2, 240, 130, NA, 30, 33, NA, 25, 95, NA, 1, NA, NA, NA, NA, NA),
"Mint" = c( 2, 205, 140, NA, 40, 12, NA, 34, 94, NA, 0.5, 1, NA, NA, NA, NA),
"BluGrn" = c( 2, 215, 120, NA, 25, 30, NA, 31, 88, NA, 0.7, 1.1, NA, NA, 45, NA),
"Teal" = c( 2, 240, 180, NA, 35, 15, NA, 35, 92, NA, 0.6, 1.1, NA, NA, 40, NA),
"TealGrn" = c( 2, 220, 125, NA, 44, 50, NA, 49, 90, NA, 0.8, 1.2, NA, NA, 60, NA),
"Emrld" = c( 2, 224, 105, NA, 23, 55, NA, 25, 92, NA, 1.5, 1, NA, NA, NA, NA),
"BluYl" = c( 2, 250, 90, NA, 40, 55, NA, 33, 98, NA, 0.5, 1, NA, NA, NA, NA),
"ag_GrnYl" = c( 2, 225, 87, NA, 27, 86, NA, 34, 92, NA, 0.9, NA, NA, NA, NA, NA),
"Peach" = c( 2, 15, 50, NA, 128, 30, NA, 55, 90, NA, 1.1, NA, NA, NA, NA, NA),
"PinkYl" = c( 2, -4, 80, NA, 100, 47, NA, 55, 96, NA, 1, NA, NA, NA, NA, NA),
"Burg" = c( 2, -10, 10, NA, 40, 40, NA, 25, 85, NA, 1.2, 1, NA, NA, 75, NA),
"BurgYl" = c( 2, -10, 55, NA, 45, 30, NA, 30, 90, NA, 0.7, 1, NA, NA, 80, NA),
"RedOr" = c( 2, -3, 53, NA, 75, 42, NA, 44, 86, NA, 0.8, 1, NA, NA, 90, NA),
"OrYel" = c( 2, 5, 72, NA, 120, 49, NA, 56, 87, NA, 1, NA, NA, NA, 125, NA),
"Purp" = c( 2, 270, 300, NA, 55, 20, NA, 42, 92, NA, 0.6, 1, NA, NA, 60, NA),
"PurpOr" = c( 2, -83, 20, NA, 55, 18, NA, 32, 90, NA, 0.6, 1, NA, NA, 65, NA),
"Sunset" = c( 2, -80, 78, NA, 60, 55, NA, 40, 91, NA, 0.8, 1, NA, NA, 75, NA),
"Magenta" = c( 2, 312, 358, NA, 50, 24, NA, 27, 85, NA, 0.6, 1.1, NA, NA, 65, NA),
"SunsetDark" = c( 2, -35, 50, NA, 55, 60, NA, 30, 90, NA, 1.2, 1, NA, NA, 120, NA),
"ag_Sunset" = c( 2, -85, 70, NA, 70, 45, NA, 25, 85, NA, 0.6, 1, NA, NA, 105, NA),
"BrwnYl" = c( 2, -20, 70, NA, 30, 20, NA, 20, 90, NA, 1, 1.1, NA, NA, 60, NA),
"YlOrRd" = c( 2, 5, 85, NA, 75, 40, NA, 25, 99, NA, 1.6, 1.3, NA, NA, 180, NA),
"YlOrBr" = c( 2, 20, 85, NA, 50, 20, NA, 25, 99, NA, 1.3, 1.5, NA, NA, 150, NA),
"OrRd" = c( 2, 0, 60, NA, 90, 10, NA, 25, 97, NA, 1, 1.5, NA, NA, 135, NA),
"Oranges" = c( 2, 20, 55, NA, 70, 10, NA, 30, 97, NA, 1.2, 1.3, NA, NA, 150, NA),
"YlGn" = c( 2, 160, 85, NA, 25, 20, NA, 25, 99, NA, 1.2, 1.6, NA, NA, 70, NA),
"YlGnBu" = c( 2, 270, 90, NA, 40, 25, NA, 15, 99, NA, 2, 1.5, NA, NA, 90, NA),
"Reds" = c( 2, 0, 35, NA, 65, 5, NA, 20, 97, NA, 1.1, 1.3, NA, NA, 150, NA),
"RdPu" = c( 2, -70, 40, NA, 45, 5, NA, 15, 97, NA, 1, 1.3, NA, NA, 100, NA),
"PuRd" = c( 2, 20, -95, NA, 60, 5, NA, 20, 97, NA, 1.6, 1.1, NA, NA, 140, NA),
"Purples" = c( 2, 275, 270, NA, 55, 5, NA, 20, 99, NA, 1.3, 1.3, NA, NA, 70, NA),
"PuBuGn" = c( 2, 160, 320, NA, 25, 5, NA, 25, 98, NA, 1.4, 1.2, NA, NA, 70, NA),
"PuBu" = c( 2, 240, 260, NA, 30, 5, NA, 25, 98, NA, 1.5, 1.2, NA, NA, 70, NA),
"Greens" = c( 2, 135, 115, NA, 35, 5, NA, 25, 98, NA, 1, 1.5, NA, NA, 70, NA),
"BuGn" = c( 2, 125, 200, NA, 30, 5, NA, 25, 98, NA, 1.4, 1.6, NA, NA, 65, NA),
"GnBu" = c( 2, 265, 95, NA, 55, 10, NA, 25, 97, NA, 1.3, 1.7, NA, NA, 80, NA),
"BuPu" = c( 2, 320, 200, NA, 40, 5, NA, 15, 98, NA, 1.2, 1.3, NA, NA, 65, NA),
"Blues" = c( 2, 260, 220, NA, 45, 5, NA, 25, 98, NA, 1.2, 1.3, NA, NA, 70, NA),
"Lajolla" = c( 2, 90, -20, NA, 40, 5, NA, 99, 5, NA, 0.7, 0.8, NA, NA, 100, NA),
"Turku" = c( 2, 10, 120, NA, 20, 0, NA, 95, 1, NA, 1.7, 0.8, NA, NA, 55, NA),
"Blue-Red" = c( 3, 260, 0, NA, 80, NA, NA, 30, 90, NA, 1.5, NA, NA, NA, NA, NA),
"Blue-Red 2" = c( 3, 260, 0, NA, 100, NA, NA, 50, 90, NA, 1, NA, NA, NA, NA, NA),
"Blue-Red 3" = c( 3, 255, 12, NA, 50, NA, NA, 20, 97, NA, 1, 1.3, NA, NA, 80, NA),
"Red-Green" = c( 3, 340, 128, NA, 60, NA, NA, 30, 97, NA, 0.8, 1.5, NA, NA, 80, NA),
"Purple-Green" = c( 3, 300, 128, NA, 30, NA, NA, 20, 95, NA, 1, 1.4, NA, NA, 65, NA),
"Purple-Brown" = c( 3, 270, 40, NA, 30, NA, NA, 20, 98, NA, 0.8, 1.2, NA, NA, 70, NA),
"Green-Brown" = c( 3, 180, 55, NA, 40, NA, NA, 25, 97, NA, 0.8, 1.4, NA, NA, 65, NA),
"Blue-Yellow 2" = c( 3, 265, 80, NA, 80, NA, NA, 40, 95, NA, 1.2, NA, NA, NA, NA, NA),
"Blue-Yellow 3" = c( 3, 265, 80, NA, 80, NA, NA, 70, 95, NA, 0.5, 2, NA, NA, NA, NA),
"Green-Orange" = c( 3, 130, 43, NA, 100, NA, NA, 70, 90, NA, 1, NA, NA, NA, NA, NA),
"Cyan-Magenta" = c( 3, 180, 330, NA, 59, NA, NA, 75, 95, NA, 1.5, NA, NA, NA, NA, NA),
"Tropic" = c( 3, 195, 325, NA, 70, NA, NA, 55, 95, NA, 1, NA, NA, NA, NA, NA),
"Broc" = c( 3, 240, 85, NA, 30, NA, NA, 15, 98, NA, 0.9, NA, NA, NA, 45, NA),
"Cork" = c( 3, 245, 125, NA, 30, NA, NA, 15, 95, NA, 0.9, 1.1, NA, NA, 55, NA),
"Vik" = c( 3, 240, 55, NA, 45, NA, NA, 15, 95, NA, 0.8, 1.1, NA, NA, 65, NA),
"Berlin" = c( 3, 240, 15, NA, 60, NA, NA, 75, 5, NA, 1.2, 1.5, NA, NA, 80, NA),
"Lisbon" = c( 3, 240, 85, NA, 30, NA, NA, 98, 8, NA, 1, NA, NA, NA, 45, NA),
"Tofino" = c( 3, 260, 120, NA, 45, NA, NA, 90, 5, NA, 0.8, 1, NA, NA, 55, NA),
"ArmyRose" = c( 4, 0, NA, 93, 73, 18, 47, 58, 98, 52, 1.5, 0.8, 0.8, 1, NA, 55),
"Earth" = c( 4, 43, 82, 221, 61, 30, 45, 50, 92, 52, 1, 1, 0.8, 1, NA, 10),
"Fall" = c( 4, 133, 77, 21, 20, 35, 100, 35, 95, 50, 1, NA, 1.5, NA, NA, NA),
"Geyser" = c( 4, 192, 77, 21, 40, 35, 100, 50, 95, 50, 1, 1, 1.2, 1, 20, NA),
"TealRose" = c( 4, 190, 77, 0, 50, 25, 80, 55, 92, 55, 1.5, 1, 1.8, 1, 15, NA),
"Temps" = c( 4, 191, 80, -4, 43, 50, 78, 55, 89, 54, 1.6, 1, 1, 1, 57, 85),
"PuOr" = c( 4, 40, NA, 270, 70, 0, 30, 30, 98, 10, 0.6, 1.4, 1.5, 1.3, 100, 65),
"RdBu" = c( 4, 20, NA, 230, 60, 0, 50, 20, 98, 15, 1.4, 1.2, 1.5, 1.5, 125, 90),
"RdGy" = c( 4, 5, 50, 50, 60, 0, 0, 20, 98, 20, 1.2, 1.2, 1, 1.2, 125, NA),
"PiYG" = c( 4, 340, NA, 115, 75, 0, 50, 30, 98, 35, 1.3, 1.4, 0.8, 1.5, 100, 80),
"PRGn" = c( 4, 300, NA, 128, 30, 0, 30, 15, 97, 25, 1.3, 1.2, 0.9, 1.5, 65, 65),
"BrBG" = c( 4, 55, NA, 180, 40, 0, 30, 25, 97, 20, 0.8, 1.4, 0.8, 1.4, 75, 45),
"RdYlBu" = c( 4, 10, 85, 260, 105, 45, 70, 35, 98, 35, 1.5, 1.2, 0.6, 1.2, 150, 10),
"RdYlGn" = c( 4, 10, 85, 140, 105, 45, 50, 35, 98, 35, 1.5, 1.2, 0.8, 1.2, 150, 75),
"Spectral" = c( 4, 0, 85, 270, 90, 45, 65, 37, 98, 37, 1, 1.2, 1, 1.2, 120, NA),
"Zissou 1" = c( 4, 218, 71, 12, 46, 88, 165, 59, 82, 52, 0.2, 1, 3, 1, 33, NA),
"Cividis" = c( 4, 255, NA, 75, 30, 0, 95, 13, 52, 92, 1.1, 1, 1, NA, 47, NA)
))
.hcl_colors_parameters$type <- factor(.hcl_colors_parameters$type,
labels = c("qualitative", "sequential", "diverging", "divergingx"))
hcl.pals <- function(type = NULL) {
if (is.null(type)) return(rownames(.hcl_colors_parameters))
type <- match.arg(tolower(type), levels(.hcl_colors_parameters$type))
rownames(.hcl_colors_parameters)[.hcl_colors_parameters$type == type]
}
## palette function a la rainbow(n, ...), heat.colors(n) etc.
hcl.colors <- function(n, palette = "viridis",
alpha = NULL, rev = FALSE, fixup = TRUE)
{
## empty palette
n <- as.integer(n[1L])
if(n < 1L) return(character())
## match palette (ignoring case, space, -, _)
fx <- function(x) tolower(gsub("[-, _, \\,, (, ), \\ , \\.]", "", x))
p <- charmatch(fx(palette), fx(rownames(.hcl_colors_parameters)))
if(is.na(p)) stop("'palette' does not match any given palette")
if(p < 1L) stop("'palette' is ambiguous")
p <- .hcl_colors_parameters[p, ]
p$type <- as.integer(p$type)
p <- as.matrix(p)[1L, , drop = TRUE]
## trajectories
lintrj <- function(i, p1, p2) p2 - (p2 - p1) * i
tritrj <- function(i, j, p1, p2, pm) ifelse(i <= j,
p2 - (p2 - pm) * i/j,
pm - (pm - p1) * abs((i - j)/(1 - j)))
seqhcl <- function(i, h1, h2, c1, c2, l1, l2, p1, p2, cmax) {
j <- 1/(1 + abs(cmax - c1) / abs(cmax - c2))
if (!is.na(j) && (j <= 0 | j >= 1)) j <- NA
hcl(h = lintrj(i, h1, h2),
c = if(is.na(j)) lintrj(i^p1, c1, c2) else tritrj(i^p1, j, c1, c2, cmax),
l = lintrj(i^p2, l1, l2),
alpha = alpha,
fixup = fixup)
}
## adapt defaults and set up HCL colors
if(p["type"] == 1L) {
## qualitative defaults
if(is.na(p["h2"])) p["h2"] <- p["h1"] + 360 * (n - 1)/n
## h/c/l trajectories
i <- seq.int(1, 0, length.out = n)
col <- hcl(h = lintrj(i, p["h1"], p["h2"]), c = p["c1"], l = p["l1"], alpha = alpha, fixup = fixup)
} else if(p["type"] == 2L) {
## sequential defaults
if(is.na(p["h2"])) p["h2"] <- p["h1"]
if(is.na(p["c2"])) p["c2"] <- 0
if(is.na(p["p2"])) p["p2"] <- p["p1"]
## h/c/l trajectories
i <- seq.int(1, 0, length.out = n)
col <- seqhcl(i, p["h1"], p["h2"], p["c1"], p["c2"], p["l1"], p["l2"], p["p1"], p["p2"], p["cmax1"])
} else if(p["type"] == 3L) {
## diverging defaults
if(is.na(p["p2"])) p["p2"] <- p["p1"]
## h/c/l trajectories
n2 <- ceiling(n/2)
i <- seq.int(1, by = -2/(n - 1), length.out = n2)
col <- c(seqhcl(i, p["h1"], p["h1"], p["c1"], 0, p["l1"], p["l2"], p["p1"], p["p2"], p["cmax1"]),
rev(seqhcl(i, p["h2"], p["h2"], p["c1"], 0, p["l1"], p["l2"], p["p1"], p["p2"], p["cmax1"])))
if(floor(n/2) < n2) col <- col[-n2]
} else if(p["type"] == 4L) {
## divergingx defaults
if(is.na(p["p2"])) p["p2"] <- p["p1"]
if(is.na(p["p4"])) p["p4"] <- p["p2"]
## h/c/l trajectories
n2 <- ceiling(n/2)
i <- seq.int(1, by = -2/(n - 1), length.out = n2)
col <- c(seqhcl(i, p["h1"], if(is.na(p["h2"])) p["h1"] else p["h2"], p["c1"], p["c2"], p["l1"], p["l2"], p["p1"], p["p2"], p["cmax1"]),
rev(seqhcl(i, p["h3"], if(is.na(p["h2"])) p["h3"] else p["h2"], p["c3"], p["c2"], p["l3"], p["l2"], p["p3"], p["p4"], p["cmax2"])))
if(floor(n/2) < n2) col <- col[-n2]
}
if(rev) col <- rev(col)
return(col)
}