-----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()
with hex-colour input (as opposed to named colours), so my code
hex numbers to decimal is unnecessary; and using ifelse() is clearer
replacing the non-matches.
I'm not so sure about avoiding the closure, since for converting
numbers of colours, your function will spend most of its time
the local function find.near() and building all.hsv. Here's an
using your rgb2col() and a comparable function employing a closure,
of your examples executed 100 times:
+ 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,
+ })
user system elapsed
0.08 0.00 0.08
[,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
(for colour selection in the Rcmdr) where a user is likely to perform
most one or two conversions of a small number of colours in a
time advantage of the second approach will depend upon the number of
the function is invoked and the number of colours converted each
-----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
colors. I took the code and comments in this thread and simplified
function even further. (Personally, I think using closures results
Rube-Goldberg code. YMMV.) The first example below is what I use
'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]]