1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
#' Compute Maximum Chroma for Given Hue and Luminance in HCL
#'
#' Compute approximately the maximum chroma possible for a given hue and
#' luminance combination in the HCL color space.
#'
#' As the possible combinations of chroma and luminance depend on hue, it is
#' not obvious which maximum chroma can be used for a given combination of hue
#' and luminance prior to calling \code{\link{polarLUV}}. To avoid having to
#' \code{fixup} the color upon conversion to RGB \code{\link{hex}} codes, the
#' \code{max_chroma} function computes (approximately) the maximum chroma
#' possible. The computations are based on interpolations of pre-computed
#' maxima in \code{max_chroma_table}, containing the maximum chroma for a given
#' hue-luminance combination (both in integers). Hence, the result may sometimes
#' still be very slightly larger than the actual maximum which can be avoided
#' by taking the \code{floor} of the approximate value.
#'
#' @param h hue value in the HCL color description, has to be in [0, 360].
#' @param l luminance value in the HCL color description, has to be in [0, 100].
#' @param floor logical. Should the chroma value be rounded down to the next
#' lower integer?
#' @return A numeric vector with the maximum chroma coordinates.
#' @seealso \code{\link[colorspace]{polarLUV}}, \code{\link[colorspace]{hex}}
#' @keywords color
#' @examples
#' max_chroma(h = 0:36 * 10, l = 50)
#' max_chroma(h = 120, l = 0:10 * 10)
#' @export
max_chroma <- function(h, l, floor = FALSE) {
## align h and l
n <- max(c(length(h), length(l)))
h <- rep_len(h, n)
l <- rep_len(l, n)
## assure h in [0, 360]
while(any(h < 0)) h[h < 0] <- h[h < 0] + 360
while(any(h >= 360)) h[h >= 360] <- h[h >= 360] - 360
## assure l in [0, 100]
l <- pmin(100, pmax(0, l))
## obtain surrounding h/l coordinates
hmin <- floor(h + 1e-8)
hmax <- ceiling(h + 1e-8)
lmin <- floor(l + 1e-8)
lmax <- ceiling(l + 1e-8)
## average
c <- (hmax - h) * (lmax - l) * colorspace::max_chroma_table[paste(hmin, lmin, sep = "-")] +
(hmax - h) * (l - lmin) * colorspace::max_chroma_table[paste(hmin, lmax, sep = "-")] +
(h - hmin) * (lmax - l) * colorspace::max_chroma_table[paste(hmax, lmin, sep = "-")] +
(h - hmin) * (l - lmin) * colorspace::max_chroma_table[paste(hmax, lmax, sep = "-")]
## catch border cases
c <- as.numeric(c) # pmin(c, 100)
c[l <= 0 | l >= 100] <- 0
## take floor to be "on the safe side"
if(floor) c <- floor(c)
return(c)
}
#' @rdname max_chroma
#' @format NULL
"max_chroma_table"
|
