>>>>> John Fox <j...@mcmaster.ca>
>>>>> on Thu, 30 May 2013 17:14:06 -0400 writes:
> 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()
Two small remarks:
1. I think you're not aware how powerful / versatile col2rgb()
is, so you should not need a hex2dec().
So, for your example colors:
> hx <- c( "#010101", "#EEEEEE", "#AA0000", "#00AA00", "#0000AA", "#AAAA00",
> "#AA00AA", "#00AAAA")
> str(hsv <- rgb2hsv(col2rgb()))
num [1:3, 1:8] 0 0 0.00392 0 0 ...
- attr(*, "dimnames")=List of 2
..$ : chr [1:3] "h" "s" "v"
..$ : NULL
2. Really a side remark only:
It's very nice and good practice to use a closure.
For cases like yours, however I find it slightly nicer to
directly construct the closure (as opposed to via an
explicitly named intermediate object):
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
}
})
Best regards,
Martin
> 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
[.............]
______________________________________________
R-help@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.
