[R] measuring distances between colours?

[Michael Friendly]

Hi John
I agree that the Lab representation is the best so far for the goal of 
perceptually
similar colors, and the approximate JND of
2.3 on the distance scale in this space is a useful, non-arbitrary 
criterion.

FWIW, your demo might better show the hex and color names adjacently, 
for direct
comparison.

cols <- c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA", "#AAAA00",
"#AA00AA", "#00AAAA")
(nms <- rgb2col(cols))
pie(rep(1, 2*length(cols)), labels=c(rbind(cols, nms)), 
col=c(rbind(cols, nms)))

-Michael

On 6/1/2013 11:31 AM, John Fox wrote:
> Hi Michael,
>
> Thanks for the Wikipedia tip -- I'd looked there but didn't find this
> article. The article explains that the Lab colour space was formulated to
> provide uniform perceptual differences between colours, with a JND of
> approximately of 2.3. Ken Knoblauch made a similar point. The article goes
> on to describe relatively complicated adjustments meant to improve the LAV
> distance metric, which are probably overkill for my application.
>
> I've programmed Lab colour matching as follows, using Euclidean distances
> and adapting Kevin Wright's modification of my original code. I used
> convertColor(), which Martin Maechler pointed out to me.
>
> ----------- snip --------------
>
> r2c <- function(){
>      all.names <- colors()
>      all.lab <- t(convertColor(t(col2rgb(all.names)), from="sRGB", to="Lab",
> scale.in=255))
>      find.near <- function(x.lab) {
>          sq.dist <- colSums((all.lab - x.lab)^2)
>          rbind(all.names[which.min(sq.dist)], min(sq.dist))
>      }
>      function(cols.hex, near=2.3){
>          cols.lab <- t(convertColor(t(col2rgb(cols.hex)), from="sRGB",
> to="Lab", scale.in=255))
>          cols.near <- apply(cols.lab, 2, find.near)
>          ifelse(cols.near[2, ] < near^2, cols.near[1, ], cols.hex)
>      }
> }
>
> rgb2col <- r2c()
>
> ----------- snip --------------
>
> A bit of experimentation suggests that this works better than using (as I
> did previously) direct RGB distances, matching more colours to names and
> providing (to my eye, with my monitor) perceptually closer matches, though
> sometimes with (again to my eye) perceptible differences. Here's an
> illustration, adapting one of Kevin's examples:
>
> ----------- snip --------------
>
> cols <- c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA", "#AAAA00",
> "#AA00AA", "#00AAAA")
> (nms <- rgb2col(cols))
> pie(rep(1, 2*length(cols)), labels=c(cols, nms), col=c(cols, nms))
>
> ----------- snip --------------
>
> Thanks again to everyone who responded to my original, naïve, question.
>
> Best,
>   John
>
>> -----Original Message-----
>> From: Michael Friendly [mailto:friendly at yorku.ca]
>> Sent: Friday, May 31, 2013 10:24 AM
>> To: John Fox
>> Cc: r-help at r-project.org; 'Martin Maechler'
>> Subject: Re: measuring distances between colours?
>>
>> Hi John
>> This has been an interesting discussion.
>> Though you have a solution for your needs, you might be interested in
>> this javascript implementation that allows you to visually compare
>> color
>> distances in various color spaces
>>
>> http://stevehanov.ca/blog/index.php?id=116
>>
>> And, all the theory of color distance is described in
>> http://en.wikipedia.org/wiki/Color_difference
>>
>> PS: This is a very handy function.  When I last tried
>> aplpack::bagplot(), it was annoying that the colors could *only*
>> be specified in hex.
>>
>> -Michael
>>
>>
>>
>> On 5/30/2013 5:14 PM, John Fox wrote:
>>> Dear all,
>>>
>>> My thanks to everyone who addressed my question. I've incorporated
>> Eik
>>> Vettorazzi's suggestion for improved conversion of hexadecimal RGB
>> colours
>>> to decimal numbers, and Martin Maechler's hint to look at
>> demo(colors). I've
>>> loosened the default definition of "close enough" from the latter,
>> since the
>>> following seems to work well for my purposes.
>>>
>>> r2c <- function(){
>>>       hex2dec <- function(hexnums) {
>>>           # suggestion of Eik Vettorazzi
>>>           sapply(strtoi(hexnums, 16L), function(x) x %/% 256^(2:0) %%
>> 256)
>>>       }
>>>       findMatch <- function(dec.col) {
>>>           sq.dist <- colSums((hsv - dec.col)^2)
>>>           rbind(which.min(sq.dist), min(sq.dist))
>>>       }
>>>       colors <- colors()
>>>       hsv <- rgb2hsv(col2rgb(colors))
>>>       function(cols, near=0.25){
>>>           cols <- sub("^#", "", toupper(cols))
>>>           dec.cols <- rgb2hsv(hex2dec(cols))
>>>           which.col <- apply(dec.cols, 2, findMatch)
>>>           matches <- colors[which.col[1, ]]
>>>           unmatched <- which.col[2, ] > near^2
>>>           matches[unmatched] <- paste("#", cols[unmatched], sep="")
>>>           matches
>>>       }
>>> }
>>>
>>> rgb2col <- r2c()
>>>
>>> For example,
>>>
>>>> rgb2col(c("010101", "EEEEEE", "AA0000", "00AA00", "0000AA",
>> "AAAA00",
>>> "AA00AA", "00AAAA"))
>>> [1] "black"         "gray93"        "darkred"       "green4"
>>> [5] "blue4"         "darkgoldenrod" "darkmagenta"   "cyan4"
>>>
>>>> rgb2col(c("010101", "090909", "090000", "000900", "000009",
>> "090900",
>>> "090009", "000909"))
>>> [1] "black"   "gray3"   "#090000" "#000900" "#000009" "#090900"
>>> [7] "#090009" "#000909"
>>>
>>> Thanks again,
>>>    John
>>
>> --
>> Michael Friendly     Email: friendly AT yorku DOT ca
>> Professor, Psychology Dept. & Chair, Quantitative Methods
>> York University      Voice: 416 736-2100 x66249 Fax: 416 736-5814
>> 4700 Keele Street    Web:   http://www.datavis.ca
>> Toronto, ONT  M3J 1P3 CANADA
>


-- 
Michael Friendly     Email: friendly AT yorku DOT ca
Professor, Psychology Dept. & Chair, Quantitative Methods
York University      Voice: 416 736-2100 x66249 Fax: 416 736-5814
4700 Keele Street    Web:   http://www.datavis.ca
Toronto, ONT  M3J 1P3 CANADA