[R] measuring distances between colours?

[John Fox]

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]]
> 
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-
> guide.html
> and provide commented, minimal, self-contained, reproducible code.