Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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

share|improve this question
    
Great, I have found both of your suggestions to be very helpful. Thank You –  John Smith Oct 5 '13 at 17:37
add comment

2 Answers

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[
 t  = Array[Table[Min[1, a    Sinc[x]^2], {x, -6 π, 6 π, .1}] &, {100}];
 t1 = Array[Table[Min[1, a /3 Sinc[x]^2], {x, -6 π, 6 π, .1}] &, {100}]; 
 ColorCombine[{Image@t, Image@t1, Image@t1}, "RGB"], {a, 5, 20}]

Mathematica graphics

share|improve this answer
add comment

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

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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