1
2cols <- t(col2rgb(palette()))
3
4## One full space1-XYZ-space2 conversion
5
6convertColor(cols, 'sRGB', 'Lab', scale.in=255)
7
8## to XYZ, then to every defined space
9
10XYZ <- convertColor(cols, 'sRGB', 'XYZ', scale.in=255)
11fromXYZ <- vapply(
12  names(colorspaces), convertColor, FUN.VALUE=XYZ,
13  from='XYZ', color=XYZ, clip=NA
14)
15round(fromXYZ, 4)
16
17## Back to XYZ, delta to original XYZ should be close to zero
18
19tol <- 1e-5
20toXYZ <- vapply(
21  dimnames(fromXYZ)[[3]],
22  function(x) all(abs(convertColor(fromXYZ[,,x], from=x, to='XYZ') - XYZ)<tol),
23  logical(1)
24)
25toXYZ
26stopifnot(all(toXYZ | is.na(toXYZ)))
27
28## Test Apple and CIE RGB on smaller gamuts since they clip
29
30XYZ2 <- XYZ * .7 + .15
31fromXYZ2 <- vapply(
32  c('Apple RGB', 'CIE RGB'), convertColor, FUN.VALUE=XYZ2,
33  from='XYZ', color=XYZ2, clip=NA
34)
35round(fromXYZ2, 4)
36toXYZ2 <- vapply(
37  dimnames(fromXYZ2)[[3]],
38  function(x)
39    all(abs(convertColor(fromXYZ2[,,x], from=x, to='XYZ') - XYZ2)<tol),
40  logical(1)
41)
42stopifnot(all(toXYZ2))
43
44# Seg.fault in R 3.5.3 -- 4.1.1 (but not 3.4.4) -- PR#18183
45stopifnot(identical(character(0),
46                    gray(numeric(), alpha=1/2)))
47
48