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]
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}]
]
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:
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]
and the principal emission lines of a neon lamp given in the other answers:
emissionSpectrum[Ne]
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]