R devel - Sep 2018 - Possible bug with chromatic adaptation in grDevices::convertColor

It appears that the chromatic adaptation feature of `grDevices::convertColor`is
broken, and likely has been for many years.? While a little surprising, it is an
obscure enough feature that there is some possibility this is actually broken,
as opposed to user error on my part.? If it turns out to the latter, I apologize
in advance for spamming this list.
Consider:
??? rgb.in <- c("#CCCCCC", "#EEEEEE")??? clr <-
t(col2rgb(rgb.in)) / 255??? clr.out <- convertColor(clr, "sRGB",
"sRGB")??? rgb(clr.out)??? ## [1] "#CCCCCC"
"#EEEEEE"
??? convertColor(clr, "sRGB", "sRGB", "D65",
"D50")??? ## Error in match.arg(from, nWhite) :??? ##?? 'arg'
must be NULL or a character vector
This appears to be because `grDevices:::chromaticAdaptation` expects the
whitepoints to be provided in the character format (e.g. "D65"), but
they are already converted by `convertColor` into the tristimulus values.? After
applying the patch at the end of this e-mail, we get:
??? clr.out <- convertColor(clr, "sRGB", "sRGB",
"D65", "D50")??? rgb(clr.out)??? ## [1] "#DACAB0"
"#FEECCE"
I do not have a great way of confirming that the conversion is correct with my
changes, but I did verify that the `M` matrix computed
within`grDevics:::chromaticAdaptation` for the
"D65"->"D50" conversion (approximately) matches the
corresponding matrix from brucelindbloom.com chromatic adaptation page:
http://www.brucelindbloom.com/Eqn_ChromAdapt.html
Additionally visual inspection via
 ??? scales::show_col(c(rgb.in, rgb(clr.out)))
is consistent with a shift from bluer indirect daylight ("D65") to
yellower direct daylight ("D50") illuminant.
It is worth noting that the adaption method currently
in`grDevices:::chromaticAdaptation` appears to be the "Von Kries"
method, not the "Bradford" method as documented in `?convertColor` and
in the comments of thesources.? I base this on comparing the cone response
domain matrices on the aforementioned brucelindbloom.com page to the `Ma` matrix
defined in`grDevics:::chromaticAdaptation`.
Given that brucelindbloom.com appears to recommend "Bradford", that
the sources suggest that was the intent, that `chromaticAdaptation` is only used
by`convertColor` in the R sources, that `chromaticAdapation` is not exported,
and that that feature appears currently inaccessible via `convertColor`, it may
be worth using this opportunity to change the adaptation method to
"Bradford".
A suggested patch follows.? It is intended to minimize the required changes,
although doing so requires a double transposition.? The transpositions could be
easily avoided, but it would require reformulating the calculations
in`chromaticAdaption`.
Best,
Brodie.

Index: src/library/grDevices/R/convertColor.R
==================================================================---
src/library/grDevices/R/convertColor.R?? ?(revision 75298)
+++ src/library/grDevices/R/convertColor.R?? ?(working copy)
@@ -81,7 +81,7 @@
?}
?
?chromaticAdaptation <- function(xyz, from, to) {
-??? ## bradford scaling algorithm
+??? ## Von Kries scaling algorithm
???? Ma <- matrix(c( 0.40024, -0.22630, 0.,
???????????????????? 0.70760,? 1.16532, 0.,
??????????????????? -0.08081,? 0.04570, 0.91822), nrow = 3L, byrow = TRUE)
@@ -242,8 +242,8 @@
?? if (is.null(from.ref.white))
?????? from.ref.white <- to.ref.white
?
-? from.ref.white <- c2to3(white.points[, from.ref.white])
-? to.ref.white?? <- c2to3(white.points[, to.ref.white])
+? from.ref.white.3 <- c2to3(white.points[, from.ref.white])
+? to.ref.white.3?? <- c2to3(white.points[, to.ref.white])
?
?? if (is.null(nrow(color)))
???? color <- matrix(color, nrow = 1L)
@@ -262,19 +262,19 @@
?????? rgb
?? }
?
-? xyz <- apply(color, 1L, from$toXYZ, from.ref.white)
+? xyz <- apply(color, 1L, from$toXYZ, from.ref.white.3)
?
?? if (is.null(nrow(xyz)))
???? xyz <- matrix(xyz, nrow = 1L)
?
-? if (!isTRUE(all.equal(from.ref.white, to.ref.white))) {
+? if (!isTRUE(all.equal(from.ref.white.3, to.ref.white.3))) {
?????? mc <- match.call()
?????? if (is.null(mc$from.ref.white) || is.null(mc$to.ref.white))
?????????? warning("color spaces use different reference whites")
-????? xyz <- chromaticAdaptation(xyz, from.ref.white, to.ref.white)
+????? xyz <- t(chromaticAdaptation(t(xyz), from.ref.white, to.ref.white))
?? }
?
-? rval <- apply(xyz, 2L, to$fromXYZ, to.ref.white)
+? rval <- apply(xyz, 2L, to$fromXYZ, to.ref.white.3)
?
?? if (inherits(to,"RGBcolorConverter"))
?????? rval <- trim(rval)




	[[alternative HTML version deleted]]

Thanks for the report (and the bug report).
I need to make time to have a closer look at this.

Paul

On 14/09/18 14:03, brodie gaslam via R-devel wrote:
> It appears that the chromatic adaptation feature of
`grDevices::convertColor`is broken, and likely has been for many years.? While a
little surprising, it is an obscure enough feature that there is some
possibility this is actually broken, as opposed to user error on my part.? If it
turns out to the latter, I apologize in advance for spamming this list.
> Consider:
>  ??? rgb.in <- c("#CCCCCC", "#EEEEEE")??? clr <-
t(col2rgb(rgb.in)) / 255??? clr.out <- convertColor(clr, "sRGB",
"sRGB")??? rgb(clr.out)??? ## [1] "#CCCCCC"
"#EEEEEE"
>  ??? convertColor(clr, "sRGB", "sRGB", "D65",
"D50")??? ## Error in match.arg(from, nWhite) :??? ##?? 'arg'
must be NULL or a character vector
> This appears to be because `grDevices:::chromaticAdaptation` expects the
whitepoints to be provided in the character format (e.g. "D65"), but
they are already converted by `convertColor` into the tristimulus values.? After
applying the patch at the end of this e-mail, we get:
>  ??? clr.out <- convertColor(clr, "sRGB", "sRGB",
"D65", "D50")??? rgb(clr.out)??? ## [1] "#DACAB0"
"#FEECCE"
> I do not have a great way of confirming that the conversion is correct with
my changes, but I did verify that the `M` matrix computed
within`grDevics:::chromaticAdaptation` for the
"D65"->"D50" conversion (approximately) matches the
corresponding matrix from brucelindbloom.com chromatic adaptation page:
> http://www.brucelindbloom.com/Eqn_ChromAdapt.html
> Additionally visual inspection via
>   ??? scales::show_col(c(rgb.in, rgb(clr.out)))
> is consistent with a shift from bluer indirect daylight ("D65")
to yellower direct daylight ("D50") illuminant.
> It is worth noting that the adaption method currently
in`grDevices:::chromaticAdaptation` appears to be the "Von Kries"
method, not the "Bradford" method as documented in `?convertColor` and
in the comments of thesources.? I base this on comparing the cone response
domain matrices on the aforementioned brucelindbloom.com page to the `Ma` matrix
defined in`grDevics:::chromaticAdaptation`.
> Given that brucelindbloom.com appears to recommend "Bradford",
that the sources suggest that was the intent, that `chromaticAdaptation` is only
used by`convertColor` in the R sources, that `chromaticAdapation` is not
exported, and that that feature appears currently inaccessible via
`convertColor`, it may be worth using this opportunity to change the adaptation
method to "Bradford".
> A suggested patch follows.? It is intended to minimize the required
changes, although doing so requires a double transposition.? The transpositions
could be easily avoided, but it would require reformulating the calculations
in`chromaticAdaption`.
> Best,
> Brodie.
> 
> Index: src/library/grDevices/R/convertColor.R
> ==================================================================> ---
src/library/grDevices/R/convertColor.R?? ?(revision 75298)
> +++ src/library/grDevices/R/convertColor.R?? ?(working copy)
> @@ -81,7 +81,7 @@
>  ?}
>   
>  ?chromaticAdaptation <- function(xyz, from, to) {
> -??? ## bradford scaling algorithm
> +??? ## Von Kries scaling algorithm
>  ???? Ma <- matrix(c( 0.40024, -0.22630, 0.,
>  ???????????????????? 0.70760,? 1.16532, 0.,
>  ??????????????????? -0.08081,? 0.04570, 0.91822), nrow = 3L, byrow = TRUE)
> @@ -242,8 +242,8 @@
>  ?? if (is.null(from.ref.white))
>  ?????? from.ref.white <- to.ref.white
>   
> -? from.ref.white <- c2to3(white.points[, from.ref.white])
> -? to.ref.white?? <- c2to3(white.points[, to.ref.white])
> +? from.ref.white.3 <- c2to3(white.points[, from.ref.white])
> +? to.ref.white.3?? <- c2to3(white.points[, to.ref.white])
>   
>  ?? if (is.null(nrow(color)))
>  ???? color <- matrix(color, nrow = 1L)
> @@ -262,19 +262,19 @@
>  ?????? rgb
>  ?? }
>   
> -? xyz <- apply(color, 1L, from$toXYZ, from.ref.white)
> +? xyz <- apply(color, 1L, from$toXYZ, from.ref.white.3)
>   
>  ?? if (is.null(nrow(xyz)))
>  ???? xyz <- matrix(xyz, nrow = 1L)
>   
> -? if (!isTRUE(all.equal(from.ref.white, to.ref.white))) {
> +? if (!isTRUE(all.equal(from.ref.white.3, to.ref.white.3))) {
>  ?????? mc <- match.call()
>  ?????? if (is.null(mc$from.ref.white) || is.null(mc$to.ref.white))
>  ?????????? warning("color spaces use different reference
whites")
> -????? xyz <- chromaticAdaptation(xyz, from.ref.white, to.ref.white)
> +????? xyz <- t(chromaticAdaptation(t(xyz), from.ref.white,
to.ref.white))
>  ?? }
>   
> -? rval <- apply(xyz, 2L, to$fromXYZ, to.ref.white)
> +? rval <- apply(xyz, 2L, to$fromXYZ, to.ref.white.3)
>   
>  ?? if (inherits(to,"RGBcolorConverter"))
>  ?????? rval <- trim(rval)
> 
> 
> 
> 
> 	[[alternative HTML version deleted]]
> 
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
> 
-- 
Dr Paul Murrell
Department of Statistics
The University of Auckland
Private Bag 92019
Auckland
New Zealand
64 9 3737599 x85392
paul at stat.auckland.ac.nz
http://www.stat.auckland.ac.nz/~paul/