[R] measuring distances between colours?

[John Fox]

Dear Eik,

Your code is better than mine. In my application, I convert at most 8
colours at a time, so I paid attention to avoiding repeatedly redefining the
local hex2decimal() function and the hsv vector, but not to the efficiency
of hex2decimal().

Thanks for this,
 John

> -----Original Message-----
> From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
> project.org] On Behalf Of Eik Vettorazzi
> Sent: Thursday, May 30, 2013 9:33 AM
> To: John Fox
> Cc: r-help at r-project.org
> Subject: Re: [R] measuring distances between colours?
> 
> Hi John,
> i would propose a one-liner for the hexcode transformation:
> 
> hex2dec<-
> function(hexnums)sapply(strtoi(hexnums,16L),function(x)x%/%256^(2:0)%%2
> 56)
> 
> #instead of
> hexnumerals <- 0:15
> names(hexnumerals) <- c(0:9, LETTERS[1:6])
> hex2decimal <- function(hexnums){
>         hexnums <- strsplit(hexnums, "")
>         decimals <- matrix(0, 3, length(hexnums))
>         decimals[1, ] <- sapply(hexnums, function(x)
>                                  sum(hexnumerals[x[1:2]] * c(16, 1)))
>         decimals[2, ] <- sapply(hexnums, function(x)
>                                  sum(hexnumerals[x[3:4]] * c(16, 1)))
>         decimals[3, ] <- sapply(hexnums, function(x)
>                                  sum(hexnumerals[x[5:6]] * c(16, 1)))
>         decimals
>     }
> #some tests
> cols<-c("AA0000", "002200", "000099", "333300", "BB00BB", "005555")
> cols<-sub("^#","",toupper(cols))
> #actually 'toupper' is not needed for hex2dec
> 
> #check results
> hex2decimal(cols)
> hex2dec(cols)
> 
> #it is not only shorter ocde, but even faster.
> 
> cols.test<-sprintf("%06X",sample(0:(256^3),100000))
> system.time(hex2decimal(cols.test))
> #       User      System verstrichen
> #       3.54        0.00        3.61
> system.time(hex2dec(cols.test))
> #       User      System verstrichen
> #       0.53        0.00        0.53
> 
> cheers.
> 
> Am 30.05.2013 14:13, schrieb John Fox:
> > Dear r-helpers,
> >
> > I'm interested in locating the named colour that's "closest" to an
> arbitrary RGB colour. The best that I've been able to come up is the
> following, which uses HSV colours for the comparison:
> >
> > r2c <- function(){
> >     hexnumerals <- 0:15
> >     names(hexnumerals) <- c(0:9, LETTERS[1:6])
> >     hex2decimal <- function(hexnums){
> >         hexnums <- strsplit(hexnums, "")
> >         decimals <- matrix(0, 3, length(hexnums))
> >         decimals[1, ] <- sapply(hexnums, function(x)
> >                                  sum(hexnumerals[x[1:2]] * c(16, 1)))
> >         decimals[2, ] <- sapply(hexnums, function(x)
> >                                  sum(hexnumerals[x[3:4]] * c(16, 1)))
> >         decimals[3, ] <- sapply(hexnums, function(x)
> >                                  sum(hexnumerals[x[5:6]] * c(16, 1)))
> >         decimals
> >     }
> >     colors <- colors()
> >     hsv <- rgb2hsv(col2rgb(colors))
> >     function(cols){
> >         cols <- sub("^#", "", toupper(cols))
> >         dec.cols <- rgb2hsv(hex2decimal(cols))
> >         colors[apply(dec.cols, 2, function(dec.col)
> >             which.min(colSums((hsv - dec.col)^2)))]
> >     }
> > }
> >
> > rgb2col <- r2c()
> >
> > I've programmed this with a closure so that hsv gets computed only
> once.
> >
> > Examples:
> >
> >> rgb2col(c("AA0000", "002200", "000099", "333300", "BB00BB",
> "#005555"))
> > [1] "darkred"   "darkgreen" "blue4"     "darkgreen" "magenta3"
> "darkgreen"
> >> rgb2col(c("AAAA00", "#00AAAA"))
> > [1] "darkgoldenrod" "cyan4"
> >
> > Some of these colour matches, e.g., "#005555" -> "darkgreen" seem
> poor to me. Even if the approach is sound, I'd like to be able to
> detect that there is no sufficiently close match in the vector of named
> colours. That is, can I establish a maximum acceptable distance in the
> HSV (or some other) colour space?
> >
> > I vaguely recall a paper or discussion concerning colour
> representation in R but can't locate it.
> >
> > Any suggestions would be appreciated.
> >
> > John
> >
> > ------------------------------------------------
> > John Fox
> > Sen. William McMaster Prof. of Social Statistics
> > Department of Sociology
> > McMaster University
> > Hamilton, Ontario, Canada
> > http://socserv.mcmaster.ca/jfox/
> >
> > ______________________________________________
> > 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.
> >
> 
> 
> --
> Eik Vettorazzi
> Institut für Medizinische Biometrie und Epidemiologie
> Universitätsklinikum Hamburg-Eppendorf
> 
> Martinistr. 52
> 20246 Hamburg
> 
> T ++49/40/7410-58243
> F ++49/40/7410-57790
> 
> --
> Pflichtangaben gemäß Gesetz über elektronische Handelsregister und
> Genossenschaftsregister sowie das Unternehmensregister (EHUG):
> 
> Universitätsklinikum Hamburg-Eppendorf; Körperschaft des öffentlichen
> Rechts; Gerichtsstand: Hamburg
> 
> Vorstandsmitglieder: Prof. Dr. Martin Zeitz (Vorsitzender), Prof. Dr.
> Dr. Uwe Koch-Gromus, Astrid Lurati (Kommissarisch), Joachim Prölß,
> Matthias Waldmann (Kommissarisch)
> 
> Bitte erwägen Sie, ob diese Mail ausgedruckt werden muss - der Umwelt
> zuliebe.
> 
> Please consider whether this mail must be printed - please think of the
> environment.
> 
> ______________________________________________
> 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.