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