Fourieroptik

Needs["ErrorBarPlots`"]

λ=Quantity[635,"Nanometers"]

(Subscript[f, 1])=Quantity[80,"Millimeters"]

Aufgabe 1

Eichung

Die Eichwerte:

gauge={{166.67,2*0.25},{326.84,2*0.43},{497.84,2*0.63},{655.84,2*0.83}}

(Subscript[plot, gauge])=ErrorListPlot[Table[{gauge[[i]],ErrorBar[0.02]},{i,1,Length[gauge]}],PlotRange->{{0,700},{0,2}}];

(Subscript[fit, gauge])=LinearModelFit[gauge,x,x,VarianceEstimatorFunction->(1&),Weights->Table[1/(0.02^2),{i,1,Length[gauge]}],IncludeConstantBasis->True]

Show[(Subscript[plot, gauge]),Plot[(Subscript[fit, gauge])[x],{x,0,700}]]

Die Steigung dieser Geraden ist der Wert »Millimeter pro Pixel«. Wir können also eine Variable
1 Pixel = x Millimeter einführen.

{Pixel,ΔPixel}=Quantity[(Subscript[fit, gauge])["ParameterTableEntries"][[2,1;;2]],"Millimeters"]

{Pixel//NumberForm[#,3]&,ΔPixel//NumberForm[#,1]&}

Lage der Minima

Wir berechnen die Abstände gleich in geeichten Pixelwerten. Der Fehler ergibt sich als zwei mal der Fehler auf ein Pixel, quadratisch addiert.

(Subscript[dist, minima])={
{1,1091.40Pixel-924.73Pixel},
{2,1173.65Pixel-844.64Pixel},
{3,1255.90Pixel-758.06Pixel},
{4,1338.15Pixel-677.98Pixel},
{5,1418.24Pixel-595.73Pixel},
{6,1496.16Pixel-511.31Pixel}
}

(Subscript[plot, dist,minima])=ErrorListPlot[Table[{QuantityMagnitude[(Subscript[dist, minima])[[i]]],ErrorBar[(Sqrt[2])QuantityMagnitude[ΔPixel]]},{i,1,Length[(Subscript[dist, minima])]}],AxesLabel->{"Ordnungszahl","Abstand der Minima [mm]"},PlotRange->{{0,7},{0,3}}];

(Subscript[fit, dist,minima])=LinearModelFit[QuantityMagnitude[(Subscript[dist, minima])],x,x,IncludeConstantBasis->False]

(Subscript[plotfit, dist,minima])=Show[(Subscript[plot, dist,minima]),Plot[(Subscript[fit, dist,minima])[x],{x,0,7}],ImageSize->Full]

{(Subscript[m, 1]),(Subscript[Δm, 1])}=Quantity[(Subscript[fit, dist,minima])["ParameterTableEntries"][[1,1;;2]],"Millimeters"]

Daraus können wir die Spaltbreite ermitteln (Herleitung siehe handgeschriebenes Dokument):

{(Subscript[d, 1]),(Subscript[Δd, 1])}=((2λ (Subscript[f, 1]))/(Subscript[m, 1])){1,((Subscript[Δm, 1])/(Subscript[m, 1]))}

((Subscript[d, 1])//NumberForm[#,4]&)±((Subscript[Δd, 1])//NumberForm[#,1]&)

Lage der Maxima

(Subscript[dist, maxima])={
1128.19Pixel-892.26Pixel,
1214.77Pixel-810.01Pixel,
1294.86Pixel-721.27Pixel,
1374.95Pixel-641.18Pixel,
1452.87Pixel-558.93Pixel,
1532.96Pixel-474.51Pixel
}

Show[(Subscript[plotfit, dist,minima]),Graphics[Join[{Gray,Dashed},Table[Line[Table[{x,QuantityMagnitude[(Subscript[dist, maxima])[[i]]]},{x,{0,7}}]],{i,1,Length[(Subscript[dist, maxima])]}]]]]

ordmax=Flatten[Table[Solve[(Subscript[fit, dist,minima])[x]==QuantityMagnitude[(Subscript[dist, maxima])[[i]]],x],{i,1,Length[(Subscript[dist, maxima])]}]][[All,2]]

Der mittlere  Fehler ist:

Mean[Abs[ordmax-Table[.5+i,{i,1,Length[ordmax]}]]]

Intensitätsverhältnisse

Für die Intensitätsverhältnisse ziehen wir allen Intensitätswerten das Mittel des Dunkelstromes ab.

(Subscript[dark, 1,unscaled])=Mean[{142.86,139.19}]

(Subscript[intensities, 1,unscaled,raw])={
{0,4880.34},
{1,Mean[{395.60,391.94}]},
{2,Mean[{256.41,223.44}]},
{3,Mean[{216.12,179.49}]},
{4,Mean[{186.81,158.73}]}
};

(Subscript[intensities, 1,unscaled])=Table[i-{0,(Subscript[dark, 1,unscaled])},{i,(Subscript[intensities, 1,unscaled,raw])}]

(Subscript[dark, 1,scaled])=Mean[{298.34,260.64}]

(Subscript[intensities, 1,scaled,raw])={
{1,Mean[{4634.08,4849.86}]},
{2,Mean[{2302.80,2153.71}]},
{3,Mean[{1200.57,1098.05}]},
{4,Mean[{680.78,655.37}]},
{5,Mean[{527.00,494.24}]},
{6,Mean[{461.31,381.90}]}
};

(Subscript[intensities, 1,scaled])=Table[i-{0,(Subscript[dark, 1,scaled])},{i,(Subscript[intensities, 1,scaled,raw])}]

intensity[n_,which_]:=Select[(Subscript[intensities, 1,which]),#[[1]]==n&][[1,2]]

(Subscript[r1, 1])=intensity[1,unscaled]/intensity[0,unscaled]

(Subscript[r1, 2])=intensity[2,scaled]/intensity[1,scaled]*intensity[1,unscaled]/intensity[0,unscaled]

(Subscript[r1, 3])=intensity[3,scaled]/intensity[1,scaled]*intensity[1,unscaled]/intensity[0,unscaled]

(Subscript[r1, 4])=intensity[4,scaled]/intensity[1,scaled]*intensity[1,unscaled]/intensity[0,unscaled]

(Subscript[r1, 5])=intensity[5,scaled]/intensity[1,scaled]*intensity[1,unscaled]/intensity[0,unscaled]

(Subscript[r1, 6])=intensity[6,scaled]/intensity[1,scaled]*intensity[1,unscaled]/intensity[0,unscaled]

Theoretisch sollten sich die Intensitäten mit (((sin^2)(((2n+1)/2)π))/(((((2n+1)/2)π))^2)) verhalten.

(Subscript[r1, 1,theor])=(1/((((1+0.5)π))^2))

(Subscript[r1, 2,theor])=(1/((((2+0.5)π))^2))

(Subscript[r1, 3,theor])=(1/((((3+0.5)π))^2))

(Subscript[r1, 4,theor])=(1/((((4+0.5)π))^2))

(Subscript[r1, 5,theor])=(1/((((5+0.5)π))^2))

(Subscript[r1, 6,theor])=(1/((((6+0.5)π))^2))

Wir bilden wieder die quadratischen Fehler (gerundet auf eine Stelle):

Table[Abs[(Subscript[r1, i])-(Subscript[r1, i,theor])],{i,1,6}]//NumberForm[#,1]&

Aufgabe 2

Berechnung des Spaltbildes mit den Werten aus Aufgabe 4:

PhysicalPixel=Quantity[14,"Micrometers"]

Brennweite ist oben gesetzt.

Bildweite:

b=Quantity[730,"Millimeters"]

(Subscript[B, width])=Mean[{130.86PhysicalPixel,124.29PhysicalPixel}]

(Subscript[B, distance])=338.20PhysicalPixel

Aus der Abbildungsgleichung folgt G = ((B f)/(b - f)).

d=(((Subscript[B, width])(Subscript[f, 1]))/(b-(Subscript[f, 1])))

g=(((Subscript[B, distance])(Subscript[f, 1]))/(b-(Subscript[f, 1])))

(g/d)

dm=QuantityMagnitude[UnitConvert[d]]

gm=QuantityMagnitude[UnitConvert[g]]

functions={((Cos[k(gm/2)])^2),1}(dm^2)(((Sin[k (dm/2)])^2)/(((k (dm/2)))^2))

(Subscript[plot, doppelspalt,theor])=Plot[functions,{k,-5((2π)/dm),5((2π)/dm)},PlotRange->Full,ImageSize->Full]

Intensitäten der Maxima

(Subscript[intensities, 2,raw])={
{0,4611.31},
{1,Mean[{2948.12,2980.11}]},
{2,Mean[{490.29,461.80}]}
}

(Subscript[dark, 2])=Mean[{173.14,140.53}]

(Subscript[intensities, 2])=Table[i-{0,(Subscript[dark, 2])},{i,(Subscript[intensities, 2,raw])}]

Verhältnisse der Maxima (0:1, 0:2)

(Subscript[r2, 1])=(Subscript[intensities, 2])[[2,2]]/(Subscript[intensities, 2])[[1,2]]

(Subscript[r2, 2])=(Subscript[intensities, 2])[[3,2]]/(Subscript[intensities, 2])[[1,2]]

Theoretische Werte:

(Subscript[r2, 1,theor])=(((Sin[π (d/g)1])^2)/(((π (d/g)1))^2))

(Subscript[r2, 2,theor])=(((Sin[π (d/g)2])^2)/(((π (d/g)2))^2))

Die Fehler:

Table[Abs[(Subscript[r2, i])-(Subscript[r2, i,theor])],{i,1,2}]//NumberForm[#,1]&

Aufgabe 3

(Subscript[F, einzelspalt])[ky_]:=dv((Sin[ky dv/2])/((ky dv/2)))

(Subscript[f, einzelspalt,mod])[y_,kn_]:=Integrate[(1/π)(Subscript[F, einzelspalt])[ky]Cos[ky y],{ky,0,kn}]

(Subscript[k, y])[n_,dv_]:=((2π n)/dv)

(Subscript[f, einzelspalt,mod,1])[y_]=((Subscript[f, einzelspalt,mod])[y,(Subscript[k, y])[1,dm]]/.{dv->dm,gv->gm});

(Subscript[f, einzelspalt,mod,2])[y_]=((Subscript[f, einzelspalt,mod])[y,(Subscript[k, y])[2,dm]]/.{dv->dm,gv->gm});

(Subscript[f, einzelspalt,mod,3])[y_]=((Subscript[f, einzelspalt,mod])[y,(Subscript[k, y])[3,dm]]/.{dv->dm,gv->gm});

norm=FindMaximum[(Subscript[f, einzelspalt,mod,1])[y],{y,0}]//First

0. Beugungsordnung

Plot[(1/(norm^2))((((Subscript[f, einzelspalt,mod,1])[y]))^2),{y,-3*dm,3*dm},PlotRange->Full,ImageSize->Full]

Vergleich der theoretischen mit den gemessenen Werten:

(Subscript[maxima, einzelspalt,1,theor])={{0,1}}

(Subscript[minima, einzelspalt,1,theor])={{min,0},{-min,0}}/.min->FindMinimum[(1/(norm^2))((((Subscript[f, einzelspalt,mod,1])[y]))^2),{y,-dm,dm}][[2,1,2]]

Wir wählen die Mitte anhand der Lage des jeweils mittig gemessenen Extremums.

(Subscript[dark, einzelspalt,1])=148.87

(Subscript[maxima, einzelspalt,1])={{0,4723.72-(Subscript[dark, einzelspalt,1])}}

(Subscript[minima, einzelspalt,1])={
{-123.73,159.01-(Subscript[dark, einzelspalt,1])},
{120.34,160.01-(Subscript[dark, einzelspalt,1])}
}

Hier gibt es nicht viel zu vergleichen, da es nur wenige Referenzpunkte gibt. Da die Minima bei 0 liegen sollten, können wir keine Verhältnisse vergleichen, und über die Lagen der Minima können wir auch nicht mehr sagen, als daß sie symmetrisch sein sollten. Da die Höhen- und Breitenachsen unabhängig voneinander sind, läßt sich hier auch nichts sagen.

Die Abweichung von der Symmetrie läßt sich indes (in Pixeln) quantifizieren:

StandardDeviation[Abs[(Subscript[minima, einzelspalt,1])[[All,1]]]]

0. und 1. Beugungsordnung

Plot[(1/(norm^2))((((Subscript[f, einzelspalt,mod,2])[y]))^2),{y,-3*dm,3*dm},PlotRange->Full,ImageSize->Full]

rawmax=FindMaximum[(1/(norm^2))((((Subscript[f, einzelspalt,mod,2])[y]))^2),{y,-dm/2,0}]

(Subscript[maxima, einzelspalt,2,theor])={{max,value},{-max,value}}/.{value->(rawmax//First),max->rawmax[[2,1,2]]}

(Subscript[minima, einzelspalt,2,theor])={{0,min}}/.min->FindMinimum[(1/(norm^2))((((Subscript[f, einzelspalt,mod,2])[y]))^2),{y,0}][[1]]

Gemessene Werte:

(Subscript[dark, einzelspalt,2])=153.19

(Subscript[maxima, einzelspalt,2])={
{-35.59,4415.61-(Subscript[dark, einzelspalt,2])},
{37.29,4442.13-(Subscript[dark, einzelspalt,2])}
}

(Subscript[minima, einzelspalt,2])={{0,3168.46-(Subscript[dark, einzelspalt,2])}}

Die Abweichung von der Symmetrie läßt sich auch hier in Pixeln quantifizieren:

StandardDeviation[Abs[(Subscript[maxima, einzelspalt,2])[[All,1]]]]

Die gemessenen Intensitäten von Maxima und Minima, normiert auf die Intensität des Maximums bei einer zugelassenen Beugungsordnung, lassen sich hier mit den theoretischen Werten vergleichen.

(Subscript[I, 2,max,links,theor])=(Subscript[maxima, einzelspalt,2,theor])[[1,2]]

(Subscript[I, 2,max,rechts,theor])=(Subscript[maxima, einzelspalt,2,theor])[[2,2]]

(Subscript[I, 2,min,theor])=(Subscript[minima, einzelspalt,2,theor])[[1,2]]

(Subscript[I, 2,max,links])=(Subscript[maxima, einzelspalt,2])[[1,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

(Subscript[I, 2,max,rechts])=(Subscript[maxima, einzelspalt,2])[[2,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

(Subscript[I, 2,min])=(Subscript[minima, einzelspalt,2])[[1,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

Die Fehler (links, rechts, mitte):

Abs[{(Subscript[I, 2,max,links,theor])-(Subscript[I, 2,max,links]),(Subscript[I, 2,max,rechts,theor])-(Subscript[I, 2,max,rechts]),(Subscript[I, 2,min,theor])-(Subscript[I, 2,min])}]//NumberForm[#,1]&

0., 1. und 2. Beugungsordnung

Plot[(1/(norm^2))((((Subscript[f, einzelspalt,mod,3])[y]))^2),{y,-3*dm,3*dm},PlotRange->Full,ImageSize->Full]

rawmax2=FindMaximum[(1/(norm^2))((((Subscript[f, einzelspalt,mod,3])[y]))^2),{y,-dm/2,0}]

(Subscript[maxima, einzelspalt,3,theor])={{max,value},{0,val0},{-max,value}}/.{value->(rawmax2//First),
max->rawmax2[[2,1,2]],
val0->FindMaximum[(1/(norm^2))((((Subscript[f, einzelspalt,mod,3])[y]))^2),{y,0}][[1]]}

rawmin=FindMinimum[(1/(norm^2))((((Subscript[f, einzelspalt,mod,3])[y]))^2),{y,-dm/4,0}]

(Subscript[minima, einzelspalt,3,theor])={{-min,value},{min,value}}/.{min->rawmin[[2,1,2]],value->rawmin[[1]]}

Gemessene Werte:

(Subscript[dark, einzelspalt,3])=142.56

(Subscript[maxima, einzelspalt,3])={
{-49.15,4349.02-(Subscript[dark, einzelspalt,3])},
{0,4087.69-(Subscript[dark, einzelspalt,3])},
{50.85,4315.42-(Subscript[dark, einzelspalt,3])}
}

(Subscript[minima, einzelspalt,3])={
{-22.03,3342.61-(Subscript[dark, einzelspalt,3])},
{25.42,3329.48-(Subscript[dark, einzelspalt,3])}
}

Die Abweichung von der Symmetrie:

Mean[{StandardDeviation[Abs[(Subscript[minima, einzelspalt,3])[[All,1]]]],
StandardDeviation[Abs[(Subscript[maxima, einzelspalt,3])[[{1,-1},1]]]]}]//NumberForm[#,3]&

Nun können wir wieder die Intensitäten vergleichen:

Theoretisch:

(Subscript[I, 3,max,1,theor])=(Subscript[maxima, einzelspalt,3,theor])[[1,2]]

(Subscript[I, 3,max,2,theor])=(Subscript[maxima, einzelspalt,3,theor])[[2,2]]

(Subscript[I, 3,max,3,theor])=(Subscript[maxima, einzelspalt,3,theor])[[3,2]]

(Subscript[I, 3,min,1,theor])=(Subscript[minima, einzelspalt,3,theor])[[1,2]]

(Subscript[I, 3,min,2,theor])=(Subscript[minima, einzelspalt,3,theor])[[2,2]]

Gemessen:

(Subscript[I, 3,max,1])=(Subscript[maxima, einzelspalt,3])[[1,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

(Subscript[I, 3,max,2])=(Subscript[maxima, einzelspalt,3])[[2,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

(Subscript[I, 3,max,3])=(Subscript[maxima, einzelspalt,3])[[3,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

(Subscript[I, 3,min,1])=(Subscript[minima, einzelspalt,3])[[1,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

(Subscript[I, 3,min,2])=(Subscript[minima, einzelspalt,3])[[2,2]]/(Subscript[maxima, einzelspalt,1])[[1,2]]

Mittlerer Fehler der Maxima:

Mean[Table[Abs[(Subscript[I, 3,max,i])-(Subscript[I, 3,max,i,theor])],{i,1,3}]]//NumberForm[#,1]&

Mittlerer Fehler der Minima:

Mean[Table[Abs[(Subscript[I, 3,min,i])-(Subscript[I, 3,min,i,theor])],{i,1,2}]]//NumberForm[#,1]&

Aufgabe 4

dml=QuantityMagnitude[d]

gml=QuantityMagnitude[g]

(Subscript[F, doppelspalt])[ky_]:=2 dv Cos[ky gv/2]((Sin[ky dv/2])/((ky dv/2)))

Wir führen Fouriersynthese durch:

(Subscript[f, doppelspalt,mod])[y_,kn_]:=Integrate[(1/π)(Subscript[F, doppelspalt])[ky]Cos[ky y],{ky,0,kn}]

(Subscript[k, y])[n_,dv_]:=((2π n)/dv)

Und vollziehen die experimentell erhaltenen Bilder nach:

(Subscript[f, doppelspalt,mod,4])[y_]=(Subscript[f, doppelspalt,mod])[y,(Subscript[k, y])[4,dv]]/.{dv->dml,gv->gml}

Plot[((((Subscript[f, doppelspalt,mod,4])[y]))^2),{y,-1000,1000},PlotRange->All,ImageSize->Full]

(Subscript[f, doppelspalt,mod,1])[y_]=(Subscript[f, doppelspalt,mod])[y,(Subscript[k, y])[1,dv]]/.{dv->dml,gv->gml}

Plot[((((Subscript[f, doppelspalt,mod,1])[y]))^2),{y,-1000,1000},PlotRange->All,ImageSize->Full]

(Subscript[f, doppelspalt,mod,n])[y_]=(Subscript[f, doppelspalt,mod])[y,(Subscript[k, y])[n,dv]]/.{dv->dml,gv->gml}

Plot[((((Subscript[f, doppelspalt,mod,n])[y]/.{n->0.255}))^2),{y,-1000,1000},PlotRange->{{-1000,1000},{0,1.5}},ImageSize->Full]

Der Grenzwert für (Subscript[k, y]) ist beim letzten Bild:

(Subscript[k, y])[.255,dm]

Den experimentellen Wert für (Subscript[k, y]) errechnen wir so:

{Δ,ΔΔ}=UnitConvert[(1/2)Quantity[{.125,.01},"Millimeters"]]

{(Subscript[k, y,exp]),(Subscript[Δk, y,exp])}=UnitConvert[((2π)/(λ (Subscript[f, 1]))){Δ,ΔΔ}]

Sieht nach σ-Übereinstimmung aus.