29
$\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$
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$
  • 5
    $\begingroup$ However, see this. $\endgroup$ – J. M. will be back soon Jun 15 '15 at 19:01
  • $\begingroup$ @J.M. Thank you for pointing that out! I included the improved color function as well. $\endgroup$ – MarcoB Jun 16 '15 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$
  • $\begingroup$ Thank you very much, this is excellent! $\endgroup$ – Ali Caglayan Jun 15 '15 at 17:48
  • $\begingroup$ @Alizter: You're very welcome! $\endgroup$ – Mahdi Jun 15 '15 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, privacy policy and cookie policy

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