[R] measuring distances between colours?

[Eik Vettorazzi]

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)%%256)

#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.