[R] measuring distances between colours?

Martin Maechler maechler at stat.math.ethz.ch
Fri May 31 09:18:07 CEST 2013


>>>>> John Fox <jfox at 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

 [.............]



More information about the R-help mailing list