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