Ohnisko dutého a parabolického zrcadla

Následující aplet umožňuje názorně zobrazit kulovou vadu dutých (kulových) zrcadel a z toho plynoucí praktické používání parabolických zrcadel.
Pomocí posuvníků lze nastavit:
	- poloměr křivosti r dutého zrcadla;
	- parametr p paraboly;
	- vzdálenost v zobrazeného paprsku od optické osy zrcadla.

Volitelně lze zobrazit:
	- jeden nebo dva paprsky (v každé polorovině od optické osy jeden);
	- ohnisko zrcadla;
	- střed (vrchol) zrcadla;
	- kolmici dopadu pro paprsek dopadající na zrcadlo;
	- tečnu, kterou v místě dopadu nahrazujeme zakřivené zrcadlo.

V apletu je propočítán pouze jeden odraz od zrcadla - další interakce světla se zrcadlem není započítávána a zobrazena!!!

Tlačítkem Ulož obrázek se uloží právě zobrazené "bílé" okno do aktuální složky (složka, v níž je uložen tento notebook) pod jménem, které je uloženo v proměnné jmenosouboru. K tomuto jménu souboru je při opakovaném ukládání grafu přidáváno pořadové číslo.
Pozor! Při každém spuštění tohoto apletu se začínají soubory číslovat opět od jedné! Tak může dojít k přepsání minule uložených obrázků.

© Jaroslav Reichl, 2009

Příprava pro vykreslení grafu

ClearAll["Global`*"];
jmenosouboru="zrcadlo_ohnisko_.jpg";
cesta=NotebookDirectory[];
pocetulozeni=0;

x1=-10;x2=-x1;
y1=-10;y2=-y1;
stredx=((x1+x2)/2);stredy=((y1+y2)/2);
stredzrcadlax=0.5x1;stredzrcadlay=stredy;
vrcholzrcadlax=0.9x2;vrcholzrcadlay=stredy;

r0=1.25x2;rmin=1.2x2;rmax=1.4x2;deltar=0.012;
p0=0.5x2;pmin=0.15x2;pmax=1.4x2;deltap=0.05x2;
v0=0.6x2;vmin=0.01;vmax=0.76x2;deltav=0.05x2;
deltavypis=0.05x2;
deltaxtecna=0.6x2;

tloustka=0.005;
velikostbodu=0.02;
velikostsipky=0.04;

barva=Black;
barvazrcadla=Black;
barvaosy=Black;
barvastredu=Darker[Green,0.5];
barvapaprsku=Red;
barvakolmice=Blue;
barvaohniska=Magenta;
barvatecny=Brown;

osa=Line[{{x1,stredy},{x2,stredy}}];
OhniskoNerovinnychZrcadel=Manipulate[Deploy[
stredkrivosti=Point[{stredzrcadlax,stredzrcadlay}];
vrchol1=Point[{stredzrcadlax+r,stredzrcadlay}];
vrchol2=Point[{vrcholzrcadlax,vrcholzrcadlay}];
ohnisko1=Point[{stredzrcadlax+(r/2),stredzrcadlay}];
ohnisko2=Point[{vrcholzrcadlax-(p/2),vrcholzrcadlay}];

If[typzrcadla==" Kulové ",
{rcezrcadla[y_]:=(Sqrt[(r^2)-(((y-stredzrcadlay))^2)])+stredzrcadlax,
rcezrcadlaprotecnu[x_]:=(Sqrt[(r^2)-(((x-stredzrcadlax))^2)])+stredzrcadlay,
zrcadlo=Circle[{stredzrcadlax,stredzrcadlay},r,{-(π/5),(π/5)}]},
{rcezrcadla[y_]:=-((((y-vrcholzrcadlay))^2)/(2p))+vrcholzrcadlax,
rcezrcadlaprotecnu[x_]:=(Sqrt[-2p(x-vrcholzrcadlax)])+vrcholzrcadlay,
parabola[x_,y_]:=(((y-vrcholzrcadlay))^2)+2p(x-vrcholzrcadlax)}];

paprsek1={
Arrowheads[{0,velikostsipky}],
Arrow[{{x1,stredy+v},{rcezrcadla[v],stredy+v}}]};
paprsek2={
Arrowheads[{0,velikostsipky}],
Arrow[{{x1,stredy-v},{rcezrcadla[v],stredy-v}}]};

smernicetecny[x_]=D[rcezrcadlaprotecnu[x],x];
tecnapom[x_]:=x smernicetecny[rcezrcadla[v]]+qpom;
reseni=Solve[tecnapom[rcezrcadla[v]]==stredy+v,qpom];
q1=qpom/.reseni[[1]];
tecna1[x_]:=tecnapom[x]/.qpom->q1;
reseni=Solve[-tecnapom[rcezrcadla[-v]]==stredy-v,qpom];
q2=qpom/.reseni[[1]];
tecna2[x_]:=-tecnapom[x]/.qpom->q2;

kolmicepom[x_]:=-(x/(smernicetecny[rcezrcadla[v]]))+qpom2;
reseni=Solve[kolmicepom[rcezrcadla[v]]==stredy+v,qpom2];
q3=qpom2/.reseni[[1]];
kolmice1[x_]:=kolmicepom[x]/.qpom2->q3;
reseni=Solve[-kolmicepom[rcezrcadla[-v]]==stredy-v,qpom2];
q4=qpom2/.reseni[[1]];
kolmice2[x_]:=-kolmicepom[x]/.qpom2->q4;

reseni=Solve[kolmice1[xpom]==stredy,xpom];
xkolmice=xpom/.reseni[[1]];

If[typzrcadla==" Kulové ",
alfa=ArcSin[(v/r)],
alfa=ArcTan[(v/(rcezrcadla[v]-xkolmice))]];
odrazenypaprsekpom[x_]:=Tan[2alfa]x+bpom;
reseni=Solve[odrazenypaprsekpom[rcezrcadla[v]]==stredy+v,bpom];
b=bpom/.reseni[[1]];
odrazenypaprsek1[x_]:=odrazenypaprsekpom[x]/.bpom->b;
reseni=Solve[-odrazenypaprsekpom[rcezrcadla[v]]==stredy-v,bpom];
b=bpom/.reseni[[1]];
odrazenypaprsek2[x_]:=-odrazenypaprsekpom[x]/.bpom->b;

If[typzrcadla≠" Kulové ",
{reseni=Solve[odrazenypaprsek2[xpom]==rcezrcadlaprotecnu[xpom],xpom],
konecpaprsku2x=xpom/.reseni[[1]],
konecpaprsku2y=rcezrcadlaprotecnu[konecpaprsku2x],
konecpaprsku1y=-konecpaprsku2y,
paprsekodraz1={
Arrowheads[{0,velikostsipky}],
Arrow[{{rcezrcadla[v],stredy+v},{konecpaprsku2x,konecpaprsku1y}}]},
paprsekodraz2={
Arrowheads[{0,velikostsipky}],
Arrow[{{rcezrcadla[v],stredy-v},{konecpaprsku2x,konecpaprsku2y}}]}},
""];

(*Meze pro vykreslovní odraženého paprsku.*)
If[Tan[alfa]<1,
{dolnimez=0.25x1,
hornimez=rcezrcadla[v]},
{dolnimez=rcezrcadla[v],
hornimez=rcezrcadla[v]+0.5x2}];

grafik=Show[
Graphics[{
{barvaosy,Thickness[0.5tloustka],Dashed,osa},
If[typzrcadla==" Kulové ",
{{barvazrcadla,Thickness[1.25tloustka],zrcadlo},
If[zobrazitbod,
{{barvastredu,PointSize[velikostbodu],stredkrivosti},
Text[Style["S",18,barvastredu,FontFamily->Times],{stredzrcadlax,stredzrcadlay-deltavypis},{Center,Top}],
{barvastredu,PointSize[velikostbodu],vrchol1},
Text[Style["V",18,barvastredu,FontFamily->Times],{stredzrcadlax+r+deltavypis,stredzrcadlay-deltavypis},{Left,Top}]},
Text[""]],
If[zobrazitohnisko,
{{barvaohniska,PointSize[velikostbodu],ohnisko1},
Text[Style["F",18,barvaohniska,FontFamily->Times],{stredzrcadlax+(r/2),stredzrcadlay-deltavypis},{Center,Top}]},
Text[""]]},
{If[zobrazitbod,
{{barvastredu,PointSize[velikostbodu],vrchol2},
Text[Style["V",18,barvastredu,FontFamily->Times],{vrcholzrcadlax+deltavypis,vrcholzrcadlay-deltavypis},{Left,Top}]},
Text[""]],
If[zobrazitohnisko,
{{barvaohniska,PointSize[velikostbodu],ohnisko2},
Text[Style["F",18,barvaohniska,FontFamily->Times],{vrcholzrcadlax-(p/2),vrcholzrcadlay-deltavypis},{Center,Top}]},
Text[""]],
{barvapaprsku,Thickness[0.8tloustka],paprsekodraz1}}],
{barvapaprsku,Thickness[0.8tloustka],paprsek1},
If[pocetpaprsku=="2",
{{barvapaprsku,Thickness[0.8tloustka],paprsek2},
If[typzrcadla≠" Kulové ",
{barvapaprsku,Thickness[0.8tloustka],paprsekodraz2},
Text[""]]},
Text[""]]}],

If[typzrcadla≠" Kulové ",
ContourPlot[parabola[x,y]==0,{x,x1,x2},{y,y1,y2},ContourStyle->{barvazrcadla,Thickness[1.25tloustka]},PlotPoints->{20},Frame->False,Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že se má vykrelit kulové zrcadlo ...*)],
If[pocetpaprsku=="1",
{If[typzrcadla==" Kulové ",
Plot[odrazenypaprsek1[x],{x,dolnimez,hornimez},PlotStyle->{barvapaprsku,Thickness[0.8tloustka]},Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že je zrcadlo parabolické ...*)],
If[zobrazittecnu,
Plot[tecna1[x],{x,rcezrcadla[v]-deltaxtecna Cos[(π/2)-alfa],rcezrcadla[v]+deltaxtecna Cos[(π/2)-alfa]},PlotStyle->{barvatecny,Thickness[0.7tloustka],Dashed},Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že se nemá vykrelit tečna ...*)],
If[zobrazitkolmici,
Plot[kolmice1[x],{x,xkolmice,rcezrcadla[v]},PlotStyle->{barvakolmice,Thickness[0.5tloustka],Dashed},Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že se nemá vykrelit kolmice dopadu ...*)]},
{If[typzrcadla==" Kulové ",
Plot[{odrazenypaprsek1[x],odrazenypaprsek2[x]},{x,dolnimez,hornimez},PlotStyle->{{barvapaprsku,Thickness[0.8tloustka]},{barvapaprsku,Thickness[0.8tloustka]}},Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že je zrcadlo parabolické ...*)],
If[zobrazittecnu,
Plot[{tecna1[x],tecna2[x]},{x,rcezrcadla[v]-deltaxtecna Cos[(π/2)-alfa],rcezrcadla[v]+deltaxtecna Cos[(π/2)-alfa]},PlotStyle->{{barvatecny,Thickness[0.7tloustka],Dashed},{barvatecny,Thickness[0.5tloustka],Dashed}},Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že se nemá vykrelit tečna ...*)],
If[zobrazitkolmici,
Plot[{kolmice1[x],kolmice2[x]},{x,xkolmice,rcezrcadla[v]},PlotStyle->{{barvakolmice,Thickness[0.5tloustka],Dashed},{barvakolmice,Thickness[0.5tloustka],Dashed}},Axes->False],
Plot[y1,{x,0,0.5},PlotStyle->{White}](*V případě, že se nemá vykrelit kolmice dopadu ...*)]}],
FormatType->StandardForm,AspectRatio->Automatic,PlotRange->{{x1,x2},{y1,y2}},ImageSize->500
]],

{{r,r0,Style["r",15,barva,Italic]},rmin,rmax,deltar},
Delimiter,
{{p,p0,Style["p",15,barva,Italic]},pmin,pmax,deltap},
Delimiter,
{{v,v0,Style["v",15,barvapaprsku,Italic]},vmin,vmax,deltav},
Delimiter,
{{typzrcadla," Kulové ",Style["typ zrcadla",15,barva,FontFamily->Times]},{" Kulové "," Parabolické "}},
Delimiter,
Item[Style["Zobrazit",20,barva,FontFamily->Times,Bold,Underlined],Alignment->Left],
{{pocetpaprsku,"1",Style["- počet paprsků",15,barvapaprsku,FontFamily->Times]},{"1","2"},ControlType->RadioButton},
{{zobrazitohnisko,True,Style["- ohnisko",15,barvaohniska,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitbod,True,Style["- střed (vrchol)",15,barvastredu,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazittecnu,True,Style["- tečnu",15,barvatecny,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitkolmici,True,Style["- kolmici",15,barvakolmice,FontFamily->Times]},{True,False},ControlType->Checkbox},
Delimiter,
Button[" Ulož obrázek ",{pocetulozeni=pocetulozeni+1,Export[StringInsert[StringJoin[cesta,jmenosouboru],ToString[pocetulozeni],-5],grafik]},ImageSize->{100,Automatic}],
ControlPlacement->Left,
FrameLabel->{Style["© Jaroslav Reichl, 2009",10,Black,FontFamily->Times],"",Style["Ohnisko dutého a parabolického zrcadla",25,Black,FontFamily->Times],""}];

Spuštění animace
Zpracujte běžným způsobem následující buňku a na dotaz, který se objeví, odpovězte ANO.

OhniskoNerovinnychZrcadel