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-boun...@r-project.org [mailto:r-help-bounces@r- > project.org] On Behalf Of Eik Vettorazzi > Sent: Thursday, May 30, 2013 9:33 AM > To: John Fox > Cc: r-help@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@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@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. ______________________________________________ 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.
