8
$\begingroup$

I'm trying to simulate Fraunhofer diffraction by a single slit using DensityPlot

I run the code:

DensityPlot[(Sinc[β])^2, {β, -6 π, 6 π}, {y, -6 π, 6 π}, PlotPoints -> 200, 
           ColorFunction -> GrayLevel, AspectRatio -> 9/16, Frame :> False]

and get:

Image

Which is great but I'd like the coloring to be based on a red scale so that the "lightest" areas are bright red which corresponds to a 632.8 nm He-Ne Laser. The following image shows the type of red scale I'd like to mimic: Red

Thanks

$\endgroup$
1
  • $\begingroup$ Great, I have found both of your suggestions to be very helpful. Thank You $\endgroup$
    – John Smith
    Oct 5 '13 at 17:37
12
$\begingroup$

First take a sample of the real image to get the right color mix:

ii = Import@"http://tsgphysics.mit.edu/pics/Q%20Diffraction/Q2-Single-Slit-Diffraction.jpg";
h = ImageTake[ii, {366, 402}, {373, 543}]
hd = Transpose[(ImageData@h)[[IntegerPart[ImageDimensions[h][[2]]/2]]]];

Mathematica graphics

Let's see the color curves. It's easy to see that the Red channel is the triple of the Blue and Green:

GraphicsRow@{ListLinePlot[hd], ListLinePlot[{1, 3, 3} hd]}

Mathematica graphics

So now we can build up a "correct" simulation:

Manipulate[
          t0 = ConstantArray[Table[Min[1, a   Sinc[x]^2], {x, -6 π, 6 π, .1}], {100}];
          t1 = ConstantArray[Table[Min[1, a/3 Sinc[x]^2], {x, -6 π, 6 π, .1}], {100}];
          ColorCombine[{Image@t0, Image@t1, Image@t1}, "RGB"], 
{a, 5, 100}] 

Mathematica graphics

$\endgroup$
9
$\begingroup$

This is a pragmatic approach, possibly if you understand more about light and lasers, you could do way better. I just use trial and error, with "manual" Blend:

DensityPlot[(Sinc[\[Beta]])^2, {\[Beta], -6 \[Pi], 6 \[Pi]}, {y, -6 \[Pi], 6 \[Pi]},
    PlotPoints -> 200, 
    ColorFunction -> (Blend[{{0, Black}, {1/3, Red}, {0.4, White}}, #] &), 
    AspectRatio -> 9/16, Frame :> False]

enter image description here

To get a better feeling, try:

Manipulate[
   DensityPlot[(Sinc[\[Beta]])^2, {\[Beta], -6 \[Pi], 6 \[Pi]}, {y, -6 \[Pi], 6 \[Pi]},      
       PlotPoints -> 200, 
       ColorFunction -> (Blend[{{0, Black}, {re, Red}, {wh, White}}, #] &),
       AspectRatio -> 9/16, Frame :> False], 
       {{re, 1/3}, 0, 1}, {{wh, 0.4}, re, 1}]

Note that the results change a bit if you reduce PlotPoints.

I hope this helps in a way...

$\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.