ColorData[“VisibleSpectrum”] is wrong?

Question

I am trying to visualize the visible spectrum using the built-in ColorData["VisibleSpectrum"] function which "colors based on light wavelength in nanometers". But I get wrong results for well-known pure colors. For example the yellow color has wavelength of 570–590 nm but ColorData["VisibleSpectrum"][580] returns green:

Is it a bug? How to visualize the visible spectrum in Mathematica correctly?

Answer 1

(too long for a comment)

Plot[{ColorData["VisibleSpectrum"][x][[1]],
      ColorData["VisibleSpectrum"][x][[2]],
      ColorData["VisibleSpectrum"][x][[3]]}, {x, 380, 750}, PlotStyle -> {Red, Green, Blue}]

It doesn't seem that you'll be able to obtain Yellow (RGBColor[1, 1, 0]) from ColorData["VisibleSpectrum"]; unfortunately, the docs say nothing about how they're blending the colors to produce "VisibleSpectrum".

---

Addendum:

Just to make this post less useless, here's a Mathematica implementation of Bruton's conversion algorithm:

brutonIntensity = Interpolation[{{380, 3/10}, {420, 1}, {700, 1}, {780, 3/10}},
                                InterpolationOrder -> 1];

brutonLambda[x_, γ_: 4/5] := Map[N[brutonIntensity[x] #]^γ &, 
    Blend[{{0, Magenta}, {3/20, Blue}, {11/40, Cyan}, {13/40, Green}, {1/2, Yellow},
           {53/80, Red}, {1, Red}}, Rescale[x, {380, 780}]]] /;
    380 <= x <= 780 && 0 < γ <= 1

Here's a gradient plot:

and an RGB component plot:

I haven't fully investigated the method for converting wavelengths to CIE xyz coordinates; maybe one of these days...

Answer 2

I just had a look at the colours as they are produced on my screen. I have been working with lasers for many (30+) years and can assure you that a 591nm laser line is fairly yellow, around 635nm is fairly red and 488nm appears as cyan, which resembles the colours of the disks well. Are you sure you are not confusing the wavelength of the maximum of black body radiation and its apparent colour with that of single lines? A perfect match of the numbers is not required but their ratios should be close.

With[{colors = {
    {Yellow, ColorData["VisibleSpectrum"][591]}, 
    {Cyan, ColorData["VisibleSpectrum"][488]}, 
    {Red, ColorData["VisibleSpectrum"][635]}}
    },
    ({#, Graphics[{#, Disk[]}] & /@ #} & /@ colors)~Flatten~1 // Grid
]

Answer 3

That's a good question. There does seem to be a considerable discrepancy versus the 1931 CIE diagram:

GraphicsGrid @ List @ Table[
   Graphics @ {ColorData["VisibleSpectrum"][i], Disk[], White, Text[i]},
   {i, 380, 700, 10}
]

Perhaps there was a miscalculation made in reducing the very large CIE color space values to sRGB triplets? sRGB, the standard display space, is the inset triangle below:

Answer 4

This is a bug (or an imperfection) of ColorData["VisibleSpectrum"].

Others have delved into its root, but in my answer I simply will make it clear by a comparison with an experimental, known single wavelength color^[1]: sodium’s D-line at 589.0 nm.

Here is Mathematica’s idea of the color of this wavelength, using default settings (no color profile conversion applied, default MMA settings on my MacBook Pro, Mac OS X 10.8.2):

Anyone who has observed the sodium D-line during as a student will know that it doesn't have that greenish hue seen above. Now, here are spectroscopic observations of this same color, for those who have never seen it:

• Fabry-Perot interferometer

  

• Michelson interferometer

  

In conclusion: sure, color conversions are tricky… but here, Mathematica is well outside the margin of error :)

 

 

 

---

[1] Well, almost single color… the two lines are not that far apart.

Answer 5

The code in the article linked by Alexey produces something similar to this (gradient plot inspired by J.M.'s comment) :

Note though that the description of the code does not seem consistent too me, so I had to change it in some places to get this result. Still I hope that I transcribed it more or less correctly. (I wouldn't use this for scientific purposes though!)

The code that creates the above figure is given below.

rgbSpec[x_] := 
RGBColor@@Piecewise[{
 {{19/100 + 19/3000 (410 - x), 0, 1 - 6/300 (410 - x)}, 380 <= x < 410}, 
 {{19/3000 (440 - x), 0, 1}, 410 <= x < 440},
 {{0, 1 - (490 - x)/50, 1}, 440 <= x < 490},
 {{0, 1, (510 - x)/20}, 490 <= x < 510},
 {{1 - (580 - x)/70, 1, 0},510 <= x < 580},
 {{1, (640 - x)/60, 0}, 580 <= x < 640},
 {{1, 0, 0}, 640 <= x < 700},
 {{35/100 + 65/8000 (780 - x), 0, 0}, 700 <= x <= 780}}]

(*rgb components*)
Plot[{rgbSpec[x][[1]], rgbSpec[x][[2]], rgbSpec[x][[3]]}, {x,380,780}, PlotStyle -> {Red, Green, Blue}, PlotRange -> All, Frame -> True]

(*gradient plot*)
DensityPlot[x, {x, 380, 780}, {y, 0, 1}, ColorFunction -> (rgbSpec[#] &), ColorFunctionScaling -> False,AspectRatio -> 1/10, FrameTicks -> {{None, None}, {Automatic, None}},Frame -> Automatic, PlotRangePadding -> None]

(If someone actually bothers to check, feel free to correct any mistakes!)

Answer 6

If you look at the interval 570-590 nm, you will clearly see that it looks green at < 580 nm. It is just a problem of what we call "yellow".