30
$\begingroup$

If I have a list of data with various wavelengths in nanometers, how would I plot them on a graph so it looks like this: emission spectrum

So far I have managed to plot a spectrum in DensityPlot, but I have no idea how to hide values that are not in my data set. I do not know if this is the correct method.

DensityPlot[x, {x, 300, 800}, {y, 0, 1}, 
ColorFunction -> ColorData["VisibleSpectrum"], 
ColorFunctionScaling -> False, AspectRatio -> .3]

I should also note that my data is nonintegral.

$\endgroup$

3 Answers 3

30
$\begingroup$

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

$\endgroup$
2
  • 5
    $\begingroup$ However, see this. $\endgroup$ Jun 15, 2015 at 19:01
  • $\begingroup$ @J.M. Thank you for pointing that out! I included the improved color function as well. $\endgroup$
    – MarcoB
    Jun 16, 2015 at 1:09
19
$\begingroup$

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

$\endgroup$
2
  • $\begingroup$ Thank you very much, this is excellent! $\endgroup$ Jun 15, 2015 at 17:48
  • $\begingroup$ @Alizter: You're very welcome! $\endgroup$
    – Mahdi
    Jun 15, 2015 at 17:51
9
$\begingroup$

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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