[Rd] Possible bug with chromatic adaptation in grDevices::convertColor

[brodie gaslam]

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]]