How to plot an emission spectrum?

You can also construct the image from Graphics primitives, which ultimately may give you more control:

spectrum[list_List] :=
 Graphics[
  {Thickness[0.005], ColorData["VisibleSpectrum"][#], Line[{{#, 0}, {#, 1}}]} & /@ list,
  PlotRange -> {{380, 750}, {0, 1}}, PlotRangePadding -> None, ImagePadding -> All,
  AspectRatio -> 1/5, ImageSize -> Large,
  Axes -> None, Frame -> {True, False, False, False},
  Prolog -> Rectangle[{0, 0}, {1000, 1}]
  ]

Using this helper function, we can plot the principal emission lines of a neon lamp (data):

Ne = {448.809226, 533.07775, 540.05617, 565.65664, 576.44188, 
   580.44496, 585.24878, 588.1895, 594.48342, 609.61631, 612.84499, 
   626.6495, 633.44278, 638.29917, 640.2246, 650.65281, 667.82764, 
   703.24131, 724.51666, 743.8899, 748.88712};

spectrum[Ne]

Mathematica graphics


Thanks to J. M. who pointed me towards an improved, more faithful version of the "VisibleSpectrum" color function developed by Mr. Wizard (A better “VisibleSpectrum” function?), whose code I reproduce below:

(* needed to pre-load internal definitions *)
ChromaticityPlot;

(* Mr. Wizard's Visible Spectrum color function*)
newVisibleSpectrum = With[
   {colors = {Image`ColorOperationsDump`$wavelengths, 
       XYZColor @@@ Image`ColorOperationsDump`tris}\[Transpose]},
   Blend[colors, #] &
   ];

This new color function can be included in a modified spectrumNew function:

spectrumNew[list_List] := 
 Graphics[{Thickness[0.003], newVisibleSpectrum[#], Line[{{#, 0}, {#, 1}}]} & /@ list, 
  PlotRange -> {{380, 750}, {0, 1}}, PlotRangePadding -> None, 
  ImagePadding -> All, AspectRatio -> 1/5, ImageSize -> Large, 
  Axes -> None, Frame -> {True, False, False, False}, 
  Prolog -> Rectangle[{0, 0}, {1000, 1}]
 ]

corrected spectrum


I prefer ListDensityPlot here as it gives flexibility to plot a range of data points. First of all, I define a function which generates a narrow spectrum around our desired wavelength:

spec[wavelength_, width_] := Flatten[Table[{{x, 0, x}, {x, 1, x}}, {x, wavelength - width, 
 wavelength + width, 0.1}], 1];

where we can specify wavelength and width of (micro-) spectrum. Then we can plot the spectrum. Assuming wavelengths for Neon (from better answer to this question):

wavelengths = {448.809226, 533.07775, 540.05617, 565.65664, 576.44188, 580.44496, 585.24878, 588.1895, 594.48342, 609.61631, 612.84499, 626.6495, 633.44278, 638.29917, 640.2246, 650.65281, 667.82764, 703.24131, 724.51666, 743.8899, 748.88712};

We can plot these wavelengths:

ListDensityPlot[spec[#, 1] & /@ wavelengths, 
  ColorFunction -> ColorData["VisibleSpectrum"], 
  ColorFunctionScaling -> False, AspectRatio -> .3, 
  PlotRange -> {{400, 800}}, 
  FrameTicks -> {Automatic, None, None, None}, 
  FrameTicksStyle -> White, Frame -> True, Background -> Black]

which results in:

enter image description here


Here's my take. You can use either newVisibleSpectrum[] or myVisibleSpectrum[] as the underlying ColorFunction; I'll use the latter.

(* smooth step function *)
smoothStep = Compile[{{a, _Real}, {b, _Real}, {x, _Real}}, 
                     With[{t = Min[Max[0, (x - a)/(b - a)], 1]}, t*t*(3 - 2 t)], 
                     RuntimeAttributes -> {Listable}];

(* smooth pulse function *)
smoothPulse[a_, x_, eps_] := smoothStep[a - eps, a, x] - smoothStep[a, a + eps, x]

emissionSpectrum[lines_, opts___] := DensityPlot[x, {x, 400, 750}, {y, 0, 50}, 
        ColorFunction -> (Darker[myVisibleSpectrum[#], 1 -
                          Total[smoothPulse[lines, #, 1.5]]] &), 
        ColorFunctionScaling -> False, opts, AspectRatio -> Automatic, 
        Background -> Black, FrameStyle -> White, 
        FrameTicks -> {True, False}, FrameTicksStyle -> White, 
        PlotPoints -> {200, 3}, PlotRangePadding -> None]

Take the Balmer series for hydrogen, for instance:

balmer = Table[100/(1.0973731568 (0.25 - k^-2)), {k, 3, 6}];
emissionSpectrum[balmer]

Balmer series

and the principal emission lines of a neon lamp given in the other answers:

emissionSpectrum[Ne]

neon spectrum


For completeness, here's how to generate an absorption spectrum:

absorptionSpectrum[lines_, opts___] := DensityPlot[x, {x, 400, 750}, {y, 0, 50}, 
          ColorFunction -> (Darker[myVisibleSpectrum[#],
                            Total[smoothPulse[lines, #, 1.5]]] &), 
          ColorFunctionScaling -> False, opts, AspectRatio -> Automatic, 
          Background -> Black, FrameStyle -> White, 
          FrameTicks -> {True, False}, FrameTicksStyle -> White, 
          PlotPoints -> {200, 3}, PlotRangePadding -> None]

Here's the absorption spectrum for neon:

absorptionSpectrum[Ne]

absorption spectrum