14
$\begingroup$

What is the best way to create the inverse function of Interpreter["Color"]? That function takes a natural language color name like "blue" as input, and returns an RGBColor as output.

Here I whipped up a basic classifier based on Mathematica's built-in color symbols:

trainingset = 
  (List @@ ColorConvert[Symbol@#, "RGB"] -> #) & /@ 
  StringSplit[
    "Red,Green,Blue,Black,White,Gray,Cyan,Magenta,Yellow,Brown,Orange,Pink,Purple", ","]

testset = {
  RGBColor[0., 0., 0., 0.],         RGBColor[0., 0., 0., 1.], 
  RGBColor[0., 0.2196, 0.7215, 1.], RGBColor[0., 0.4235, 0.2078, 1.], 
  RGBColor[0., 0.4784, 0.2392, 1.], RGBColor[0.8078, 0.0666, 0.1490, 1.],
  RGBColor[1., 1., 1., 1.],         RGBColor[1., 0.8705, 0., 1.],
  RGBColor[0.2039, 0.6980, 0.2, 1.],RGBColor[0.0039, 0., 0.4, 1.]
}

c = Classify[trainingset]

c /@ Take[#, 3] & /@ (List @@ ColorConvert[#, "RGB"] & /@ testset)

(*
  {"Black", "Black", "Blue", "Black", "Green", "Red", "White", "Yellow", "Green", "Black"}
*)

I'm not sure how well it works in general, but the darker colors seem to come out as "Black".

$\endgroup$
  • 2
    $\begingroup$ I am reminded of the xkcd color survey... anyway, maybe the new ColorDistance[] function could be useful here? $\endgroup$ – J. M. will be back soon Aug 17 '15 at 9:49
  • $\begingroup$ Please explain how the question is unclear, close voters. $\endgroup$ – hftf Aug 17 '15 at 14:12
  • 2
    $\begingroup$ Yeah, I don't understand the close votes; the question looks pretty straightforward... $\endgroup$ – J. M. will be back soon Aug 17 '15 at 14:14
  • $\begingroup$ This seems not so much a coding question as 'where do i get an appropriate training set'. Do you want to distill the answer down to a handful of basic colors (how many?), or do you want to feed it thousands of examples and likely get answers like "Crayola PinkSherbert". For the record I didn't downvote and I do think whoever did ought to explain. $\endgroup$ – george2079 Aug 18 '15 at 17:36
  • 1
    $\begingroup$ Oops! Still, I think it knows more colors than the "Named" sets: Interpreter["Color"] /@ {"amaranth","bronze","blond"} for example. $\endgroup$ – hftf Aug 18 '15 at 19:55
6
$\begingroup$

This could provide a good starting point:

First step is to provide multiple examples of "red", "blue", etc for the training set. I found a site that had some convenient images for this task. For example a good sample of "reds":

enter image description here

So I import the images:

images = Import[
   "http://ingridsundberg.com/2014/02/04/the-color-thesaurus/", 
   "Images"][[2 ;; 13]];

assign some labels:

names = {"white", "tan", "yellow", "orange", "red", "pink", "purple", 
         "blue", "green", "brown", "gray", "black"}

pull out the "dominant" colors:

colors=DominantColors[#, 20, ColorCoverage -> 1/30, MinColorDistance -> 0] & /@ images;

and then train (but first I remove the RGBColor head as I had some difficulties passing RGBColor[r,g,b] directly to Classify)

training = Apply[List,colors,2];
cf = Classify[<|Thread[names -> training]|>];

from there I get some decent results:

cf[List @@ Brown]
(* "brown" *)

cf[List @@ Orange]
(* "orange" *)

cf[{0.1, 0.25, 0}]
(* "green" *)

Manipulate[cf[List @@ color], {color, Red}]

enter image description here

$\endgroup$
  • $\begingroup$ It feels strange to arbitrarily trust Ingrid Sundberg. (For example, who knows how long these URLs will work?) Why not use built-in Wolfram data? I think ColorData[#][[3, 1]] & /@ {"HTML", "Crayola"} could be useful. $\endgroup$ – hftf Aug 18 '15 at 17:15
  • 2
    $\begingroup$ @hftf, this is meant to provide a start, not a complete solution. The general idea should be pretty much the same. $\endgroup$ – chuy Aug 18 '15 at 17:58
  • $\begingroup$ What I mean is, how are Ingrid Sundberg's color names going to get the domain of the Interpreter["Color"] function? Try Interpreter["Color"]/@ StringSplit["red merlot scarlet mahogany currant cherry garnet wine blood blush rose crimson brick sangria candy jam ruby apple berry lipstick"," "] for example. $\endgroup$ – hftf Aug 18 '15 at 18:09
4
$\begingroup$

One way is to ask WolframAlpha, but it can be slow and requires internet connectivity.

NearestHTMLColorNames[color_] := Rest[WolframAlpha[
  StringDelete[ToString[ColorConvert[color, "RGB"]], "Color"],
  {{"NearestNamedHTML:ColorData", 1}, "ComputableData"}, 
   PodStates -> {"NearestNamedHTML:ColorData__More"}]][[All, 2]]

NearestHTMLColorNames[RGBColor[0, 0, 1]]
{"blue", "medium blue", "dark blue", "navy", "dodger blue", "blue violet"}

This problem was a lot harder than I anticipated! The reason being, the closest distance in Euclidean space does not necessarily mean two colors will look the same.

The idea I has was to look at color's positions in a 3D chromaticity plot and grab the nearest named color to it. The results are ok...

(* my list of names *)
names = {"white", "tan", "yellow", "orange", "red", "pink", "purple", "blue", "green", "brown", "gray", "black", "turquoise"};

(* find their values *)
colors = Interpreter["Color"][#] -> # & /@ names

enter image description here

(* allow lighter and darker variants as well *)
colors = Join @@ (If[MatchQ[#2, "white" | "black"], {#1 -> #2}, 
 {Lighter[#1] -> #2, #1 -> #2, Darker[#1] -> #2}] & @@@ colors)

enter image description here

(* find the location of these colors in ChromaticityPlot3D *)
chromaticitylocations = Rule @@@ Reverse /@ 
 Partition[ChromaticityPlot3D[colors[[All, 1]]][[1, 2]], 2] /. 
  Point -> Identity /. c_?ColorQ :> First[Nearest[colors, c]];

(* create our function using Nearest *)
With[{nf = Nearest[chromaticitylocations]},
  NearestColorName[color_] := First[nf[FirstCase[
   ChromaticityPlot3D[color], Point[p_] :> p, _, ∞]]]
]

Now we test and see the results aren't terrible.

{#, NearestColorName[#]} & /@ RandomColor[40]

enter image description here

We can see the main issue is gray... Probably a simple way to improve this is to use a larger named color bank.

$\endgroup$
  • $\begingroup$ I wonder if the ChromaticityPlot gives more accurate results than Nearest[colors, #, DistanceFunction -> "CIE2000"]? I think the "gray" problem might have to do with it being represented as a GrayLevel. $\endgroup$ – hftf Aug 18 '15 at 19:08
  • $\begingroup$ @hftf That's a good question. I played around with different DistanceFunctions for ColorDistance and ChromaticityPlot3D empirically seemed to give the best results. TBH I don't know much about this stuff to give anymore insight :/ $\endgroup$ – Chip Hurst Aug 18 '15 at 19:23
  • 1
    $\begingroup$ It's okay, I'm colorblind ;) $\endgroup$ – hftf Aug 18 '15 at 19:33
  • 1
    $\begingroup$ @ChipHurst The default ref space for ChromaticityPlot is CIE Yxy, therefore you are clustering using the euclidean distance in that space. $\endgroup$ – Batracos Mar 16 '16 at 16:39
3
$\begingroup$

As nobody mentioned it, there is a "Named" ColorData called "HTML that gives (a subset?) of the HTML colors.

Short[ColorData["HTML", "ColorRules"], 2]

Short[ColorData["HTML", "ColorRules"], 2]

It takes nothing to build a NearestFunction from that.

SetAttributes[NearestHTMLColorNames, Listable]

NearestHTMLColorNames[color_?ColorQ] :=
 With[{nf = Nearest[Map[Reverse, ColorData["HTML", "ColorRules"]]]},
  First[nf[color], Missing[]]
 ]

And that apply that to a list of colors

{#, NearestHTMLColorNames[#]} &@RandomColor[12] // Transpose // Grid

color table

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.