measuring distances between colours?

rgb2col2 <- local({

rgb2col2(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA", 

rgb2col <- local({

rgb2col(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

rgb2col(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

-----Original Message-----
From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
project.org] On Behalf Of Michael Friendly
Sent: Saturday, June 01, 2013 11:33 AM
To: John Fox
Cc: 'r-help'; 'Martin Maechler'
Subject: Re: [R] measuring distances between colours?

Just a quick note:  The following two versions of your function don't
give the same results.  I'm not sure why, and also not sure why the
criterion for 'near' should be expressed in squared distance.

# version 1
rgb2col <- local({
     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
     }
})

# version 2
rgb2col2 <- local({
       all.names <- colors()
       all.hsv <- rgb2hsv(col2rgb(all.names))
       find.near <- function(x.hsv) {
           # return the nearest R color name and distance
           sq.dist <- colSums((all.hsv - x.hsv)^2)
           rbind(all.names[which.min(sq.dist)], min(sq.dist))
       }
       function(cols.hex, near=.25){
           cols.hsv <- rgb2hsv(col2rgb(cols.hex))
           cols.near <- apply(cols.hsv, 2, find.near)
           ifelse(cols.near[2,] < near^2, cols.near[1,], cols.hex)
       }
})

# tests

 > rgb2col(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA"))
[1] "black"         "gray93"        "darkred"       "green4"
[5] "blue4"         "darkgoldenrod" "darkmagenta"   "cyan4"

 > rgb2col2(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA"))
[1] "#010101"       "#EEEEEE"       "darkred"       "green4"
[5] "blue4"         "darkgoldenrod" "darkmagenta"   "cyan4"

 >

On 5/31/2013 7:42 PM, John Fox wrote:

Dear Kevin,

I generally prefer your solution. I didn't realize that col2rgb()

worked

with hex-colour input (as opposed to named colours), so my code

converting

hex numbers to decimal is unnecessary; and using ifelse() is clearer

than

replacing the non-matches.

I'm not so sure about avoiding the closure, since for converting

small

numbers of colours, your function will spend most of its time

constructing

the local function find.near() and building all.hsv. Here's an

example,

using your rgb2col() and a comparable function employing a closure,

with one

of your examples executed 100 times:

r2c <- function(){

+     all.names <- colors()
+     all.hsv <- rgb2hsv(col2rgb(all.names))
+     find.near <- function(x.hsv) {
+         # return the nearest R color name and distance
+         sq.dist <- colSums((all.hsv - x.hsv)^2)
+         rbind(all.names[which.min(sq.dist)], min(sq.dist))
+     }
+     function(cols.hex, near=.25){
+         cols.hsv <- rgb2hsv(col2rgb(cols.hex))
+         cols.near <- apply(cols.hsv, 2, find.near)
+         ifelse(cols.near[2,] < near^2, cols.near[1,], cols.hex)
+     }
+ }

mycols <- c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

+     "#AAAA00", "#AA00AA", "#00AAAA")

system.time(for (i in 1:100) oldnew <- c(mycols, rgb2col(mycols,

near=.25)))
    user  system elapsed
    1.97    0.00    1.97

system.time({rgb2col2 <- r2c()

+     for (i in 1:100) oldnew2 <- c(mycols, rgb2col2(mycols,

near=.25))

+     })
    user  system elapsed
    0.08    0.00    0.08

rbind(oldnew, oldnew2)

         [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
oldnew  "#010101" "#EEEEEE" "#AA0000" "#00AA00" "#0000AA" "#AAAA00"
oldnew2 "#010101" "#EEEEEE" "#AA0000" "#00AA00" "#0000AA" "#AAAA00"
         [,7]      [,8]      [,9]      [,10]     [,11]     [,12]
oldnew  "#AA00AA" "#00AAAA" "#010101" "#EEEEEE" "darkred" "green4"
oldnew2 "#AA00AA" "#00AAAA" "#010101" "#EEEEEE" "darkred" "green4"
         [,13]   [,14]           [,15]         [,16]
oldnew  "blue4" "darkgoldenrod" "darkmagenta" "cyan4"
oldnew2 "blue4" "darkgoldenrod" "darkmagenta" "cyan4"

Does this really make a difference? Frankly, it wouldn't for my

application

(for colour selection in the Rcmdr) where a user is likely to perform

at

most one or two conversions of a small number of colours in a

session. The

time advantage of the second approach will depend upon the number of

times

the function is invoked and the number of colours converted each

time.

Best,
  John

-----Original Message-----
From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
project.org] On Behalf Of Kevin Wright
Sent: Friday, May 31, 2013 3:39 PM
To: Martin Maechler
Cc: r-help; John Fox
Subject: Re: [R] measuring distances between colours?

Thanks for the discussion.  I've also wanted to be able to find

nearest

colors.  I took the code and comments in this thread and simplified

the

function even further.  (Personally, I think using closures results

in

Rube-Goldberg code.  YMMV.)  The first example below is what I use

for

'group' colors in lattice.

Kevin Wright

rgb2col <- function(cols.hex, near=.25){
   # Given a vector of hex colors, find the nearest 'named' R colors
   # If no color closer than 'near' is found, return the hex color
   # Authors: John Fox, Martin Maechler, Kevin Wright
   # From r-help discussion 5.30.13

   find.near <- function(x.hsv) {
     # return the nearest R color name and distance
     sq.dist <- colSums((all.hsv - x.hsv)^2)
     rbind(all.names[which.min(sq.dist)], min(sq.dist))
   }
   all.names <- colors()
   all.hsv <- rgb2hsv(col2rgb(all.names))
   cols.hsv <- rgb2hsv(col2rgb(cols.hex))
   cols.near <- apply(cols.hsv, 2, find.near)
   ifelse(cols.near[2,] < near^2, cols.near[1,], cols.hex)
}

mycols <- c("royalblue", "red", "#009900", "dark orange", "#999999",
"#a6761d", "#aa00da")
mycols <- c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",
"#AAAA00", "#AA00AA", "#00AAAA")
mycols <- c("#010101", "#090909", "#090000", "#000900", "#000009",
"#090900", "#090009", "#000909")
oldnew <- c(mycols, rgb2col(mycols, near=.25)) # Also try near=10
pie(rep(1,2*length(mycols)), labels=oldnew, col=oldnew)

	[[alternative HTML version deleted]]

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

-----Original Message-----
From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
project.org] On Behalf Of Kevin Wright
Sent: Sunday, June 02, 2013 10:43 AM
To: John Fox
Cc: r-help; Michael Friendly; Martin Maechler
Subject: Re: [R] measuring distances between colours?

Sorry about the bug. How embarrassing. Especially because I've learned
over
the years to trust my gut feelings when something doesn't feel quite
right,
and when I was testing the function, I remember thinking "surely there
a
better matching named color than 'magenta'".

Thanks for the fix.

Kevin



On Sat, Jun 1, 2013 at 11:30 AM, John Fox <jfox at mcmaster.ca> wrote:

Hi Michael,

This has become a bit of a comedy of errors.

The bug is in Kevin Wright's code, which I adapted, and you too in

your

version, which uses local() rather than function() to produce the

closure.

The matrix which.col contains character data, as a consequence of

binding

the minimum squared distances to colour names, and thus the

comparison

cols.near[2,] < near^2 doesn't work properly when, ironically, the

distance

is small enough so that it's rendered in scientific notation.

Converting to numeric appears to work:

rgb2col2 <- local({

+     all.names <- colors()
+     all.hsv <- rgb2hsv(col2rgb(all.names))
+     find.near <- function(x.hsv) {
+         # return the nearest R color name and distance
+         sq.dist <- colSums((all.hsv - x.hsv)^2)
+         rbind(all.names[which.min(sq.dist)], min(sq.dist))
+     }
+     function(cols.hex, near=.25){
+         cols.hsv <- rgb2hsv(col2rgb(cols.hex))
+         cols.near <- apply(cols.hsv, 2, find.near)
+         ifelse(as.numeric(cols.near[2,]) <= near^2, cols.near[1,],
cols.hex)
+     }
+ })

rgb2col2(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

+     "#AAAA00", "#AA00AA", "#00AAAA"))

[1] "black"         "gray93"        "darkred"       "green4"

"blue4"

"darkgoldenrod"
[7] "darkmagenta"   "cyan4"

The same bug is in the code that I just posted using Lab colours, so

(for

posterity) here's a fixed version of that, using local():

rgb2col <- local({

+     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(as.numeric(cols.near[2, ]) < near^2, cols.near[1, ],
toupper(cols.hex))
+     }
+ })

rgb2col(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA"))

[1] "black"   "gray93"  "#AA0000" "#00AA00" "#0000AA" "#AAAA00"
[7] "#AA00AA" "#00AAAA"

rgb2col(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA"), near=15)

[1] "black"         "gray93"        "firebrick3"    "limegreen"
[5] "blue4"         "#AAAA00"       "darkmagenta"   "lightseagreen"

So with Lab colours, setting near to the JND of 2.3 leaves many of

these

colours unmatched. I experimented a bit, and using 15 (as above)

produces

matches that appear reasonably "close" to me.

I used squared distances to avoid taking the square-roots of all the
distances. Since the criterion for "near" colours, which is on the

distance

scale, is squared to make the comparison, this shouldn't be

problematic.

I hope that finally this will be a satisfactory solution.

Best,
 John

-----Original Message-----
From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
project.org] On Behalf Of Michael Friendly
Sent: Saturday, June 01, 2013 11:33 AM
To: John Fox
Cc: 'r-help'; 'Martin Maechler'
Subject: Re: [R] measuring distances between colours?

Just a quick note:  The following two versions of your function

don't

give the same results.  I'm not sure why, and also not sure why the
criterion for 'near' should be expressed in squared distance.

# version 1
rgb2col <- local({
     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
     }
})

# version 2
rgb2col2 <- local({
       all.names <- colors()
       all.hsv <- rgb2hsv(col2rgb(all.names))
       find.near <- function(x.hsv) {
           # return the nearest R color name and distance
           sq.dist <- colSums((all.hsv - x.hsv)^2)
           rbind(all.names[which.min(sq.dist)], min(sq.dist))
       }
       function(cols.hex, near=.25){
           cols.hsv <- rgb2hsv(col2rgb(cols.hex))
           cols.near <- apply(cols.hsv, 2, find.near)
           ifelse(cols.near[2,] < near^2, cols.near[1,], cols.hex)
       }
})

# tests

 > rgb2col(c("#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA"))
[1] "black"         "gray93"        "darkred"       "green4"
[5] "blue4"         "darkgoldenrod" "darkmagenta"   "cyan4"

 > rgb2col2(c("#010101", "#EEEEEE", "#AA0000", "#00AA00",

"#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA"))
[1] "#010101"       "#EEEEEE"       "darkred"       "green4"
[5] "blue4"         "darkgoldenrod" "darkmagenta"   "cyan4"

 >

On 5/31/2013 7:42 PM, John Fox wrote:

Dear Kevin,

I generally prefer your solution. I didn't realize that col2rgb()

worked

with hex-colour input (as opposed to named colours), so my code

converting

hex numbers to decimal is unnecessary; and using ifelse() is

clearer

than

replacing the non-matches.

I'm not so sure about avoiding the closure, since for converting

small

numbers of colours, your function will spend most of its time

constructing

the local function find.near() and building all.hsv. Here's an

example,

using your rgb2col() and a comparable function employing a

closure,

with one

of your examples executed 100 times:

r2c <- function(){

+     all.names <- colors()
+     all.hsv <- rgb2hsv(col2rgb(all.names))
+     find.near <- function(x.hsv) {
+         # return the nearest R color name and distance
+         sq.dist <- colSums((all.hsv - x.hsv)^2)
+         rbind(all.names[which.min(sq.dist)], min(sq.dist))
+     }
+     function(cols.hex, near=.25){
+         cols.hsv <- rgb2hsv(col2rgb(cols.hex))
+         cols.near <- apply(cols.hsv, 2, find.near)
+         ifelse(cols.near[2,] < near^2, cols.near[1,], cols.hex)
+     }
+ }

mycols <- c("#010101", "#EEEEEE", "#AA0000", "#00AA00",

"#0000AA",

+     "#AAAA00", "#AA00AA", "#00AAAA")

system.time(for (i in 1:100) oldnew <- c(mycols, rgb2col(mycols,

near=.25)))
    user  system elapsed
    1.97    0.00    1.97

system.time({rgb2col2 <- r2c()

+     for (i in 1:100) oldnew2 <- c(mycols, rgb2col2(mycols,

near=.25))

+     })
    user  system elapsed
    0.08    0.00    0.08

rbind(oldnew, oldnew2)

         [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
oldnew  "#010101" "#EEEEEE" "#AA0000" "#00AA00" "#0000AA"

"#AAAA00"

oldnew2 "#010101" "#EEEEEE" "#AA0000" "#00AA00" "#0000AA"

"#AAAA00"

         [,7]      [,8]      [,9]      [,10]     [,11]     [,12]
oldnew  "#AA00AA" "#00AAAA" "#010101" "#EEEEEE" "darkred"

"green4"

oldnew2 "#AA00AA" "#00AAAA" "#010101" "#EEEEEE" "darkred"

"green4"

         [,13]   [,14]           [,15]         [,16]
oldnew  "blue4" "darkgoldenrod" "darkmagenta" "cyan4"
oldnew2 "blue4" "darkgoldenrod" "darkmagenta" "cyan4"

Does this really make a difference? Frankly, it wouldn't for my

application

(for colour selection in the Rcmdr) where a user is likely to

perform

at

most one or two conversions of a small number of colours in a

session. The

time advantage of the second approach will depend upon the number

of

times

the function is invoked and the number of colours converted each

time.

Best,
  John

-----Original Message-----
From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
project.org] On Behalf Of Kevin Wright
Sent: Friday, May 31, 2013 3:39 PM
To: Martin Maechler
Cc: r-help; John Fox
Subject: Re: [R] measuring distances between colours?

Thanks for the discussion.  I've also wanted to be able to find

nearest

colors.  I took the code and comments in this thread and

simplified

the

function even further.  (Personally, I think using closures

results

in

Rube-Goldberg code.  YMMV.)  The first example below is what I

use

for

'group' colors in lattice.

Kevin Wright

rgb2col <- function(cols.hex, near=.25){
   # Given a vector of hex colors, find the nearest 'named' R

colors

   # If no color closer than 'near' is found, return the hex

color

   # Authors: John Fox, Martin Maechler, Kevin Wright
   # From r-help discussion 5.30.13

   find.near <- function(x.hsv) {
     # return the nearest R color name and distance
     sq.dist <- colSums((all.hsv - x.hsv)^2)
     rbind(all.names[which.min(sq.dist)], min(sq.dist))
   }
   all.names <- colors()
   all.hsv <- rgb2hsv(col2rgb(all.names))
   cols.hsv <- rgb2hsv(col2rgb(cols.hex))
   cols.near <- apply(cols.hsv, 2, find.near)
   ifelse(cols.near[2,] < near^2, cols.near[1,], cols.hex)
}

mycols <- c("royalblue", "red", "#009900", "dark orange",

"#999999",

"#a6761d", "#aa00da")
mycols <- c("#010101", "#EEEEEE", "#AA0000", "#00AA00",

"#0000AA",

"#AAAA00", "#AA00AA", "#00AAAA")
mycols <- c("#010101", "#090909", "#090000", "#000900",

"#000009",

"#090900", "#090009", "#000909")
oldnew <- c(mycols, rgb2col(mycols, near=.25)) # Also try

near=10

pie(rep(1,2*length(mycols)), labels=oldnew, col=oldnew)

   [[alternative HTML version deleted]]

project.org/posting-

guide.html

code.

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

--
Kevin Wright

	[[alternative HTML version deleted]]