Zobrazení zrcadlem

Následující aplet umožňuje názorně pochopit zobrazení předmětu dutým a vypuklým kulovým zrcadlem. Pomocí posuvníků lze nastavit libovolnou kombinaci ohniskové vzdálenosti f, vzdálenosti a vzoru od zrcadla a výšky y vzoru. Předdefinované rozsahy koeficientů může uživatel znalý Mathematicy měnit. Lze vybírat mezi zobrazením dutým nebo vypuklým zrcadlem, nastavit výpis dopočítávaných veličin, zobrazení "význačných" paprsků, ...
Tlačítkem Ulož obrázek se uloží právě zobrazená situace 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, 2008

Příprava pro vykreslení

jmenosouboru="zrcadlo_.jpg";
cesta=NotebookDirectory[];
pocetulozeni=0;
x1=-10;x2=10;
y1=-5;y2=5;
stredx=0;stredy=0;
deltay=4;
deltayvypis=0.8;

fmax=5;
ymax=5;
amax=10;
barva=Black;
barvaf=Orange;
barvastred=Magenta;
barvaa=Blue;
barvaobraz=Red;
barvap1=RGBColor[0,1,0];
barvap2=RGBColor[0,0.7,0.8];
barvap3=RGBColor[0.7,0.7,0];

velikostf=0.02;
sipkapaprsek=0.02;

uhel=(π/6);

Zrcadla=Manipulate[
If[typzrcadla=="Duté",
znamenko=1,
znamenko=-1];

polomerzrcadla=((2y2 f)/fmax);
(*stredzrcadla=stredx+y2-polomerzrcadla;*)
stredzrcadla=stredx-polomerzrcadla;

zrcadlodute=Circle[{stredzrcadla,stredy},polomerzrcadla,{-uhel,uhel}];
zrcadlovypukle=Circle[{-stredzrcadla,stredy},polomerzrcadla,{π-uhel,π+uhel}];
hlavnirovinazrcadla=Line[{{stredzrcadla+polomerzrcadla,stredy+y2},{stredzrcadla+polomerzrcadla,stredy-y2}}];
ohnisko1=Point[{stredx-znamenko f,stredy}];
stredkrivosti=Point[{stredx-2znamenko f,stredy}];

vzorsipka={
Arrowheads[{0,0.025}],
Arrow[{{-a,stredy},{-a,yvzor}}]};
obrazsipka={
Arrowheads[{0,0.025}],
Arrow[{{aobraz,stredy},{aobraz,yobraz}}]};


areseni=Solve[(1/a)+(1/apom)==(znamenko/f),apom];
If[areseni≠{},
{aobraz=-(apom/.areseni[[1]]);
yreseni=Solve[(aobraz/a)==(ypom/yvzor),ypom],
yobraz=ypom/.yreseni[[1]],
paprsek11={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{stredx,yvzor}}]},
paprsek12=Line[{{stredx,yvzor},{aobraz,yobraz}}],
paprsek13={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{stredx,yvzor},{x1,((stredy -yobraz)/(-f-aobraz))(x1+f)+stredy}}]},
paprsek14={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{stredx,yvzor},{-f,2yvzor}}]},
paprsek15=Line[{{stredx,yvzor},{f,stredy}}],
If[a≠-aobraz,
{paprsek21=Line[{{-a,yvzor},{aobraz,yobraz}}],
paprsek22={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{stredx,((-yvzor +yobraz)/(a+aobraz))a+yvzor}}]},
paprsek23={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{stredx,((-yvzor +yobraz)/(a+aobraz))a+yvzor}}]},
paprsek24=Line[{{stredx,((-yvzor +yobraz)/(a+aobraz))a+yvzor},{aobraz,yobraz}}],
paprsek25={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{x1,((yvzor -yobraz)/(-a-aobraz))(x1+a)+yvzor}}]},
paprsek26=Line[{{stredx,((-yvzor +yobraz)/(a+aobraz))a+yvzor},{stredx-2znamenko f,stredy}}],
paprsek27={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{x1,((yvzor -yobraz)/(-a-aobraz))(x1+a)+yvzor}}]}}],
paprsek31={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{stredx,yobraz}}]},
paprsek32=Line[{{stredx,yobraz},{aobraz,yobraz}}],
paprsek33=Line[{{-znamenko f,stredy},{-a,yvzor}}],
paprsek34={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{stredx,yobraz},{x1,yobraz}}]},
paprsek35=Line[{{stredx,yobraz},{-znamenko f,stredy}}],
paprsek36={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{stredx,yobraz},{x1,yobraz}}]}},
""];

grafik=Deploy[Show[
Plot[{0},{x,x1,x2},PlotStyle->{barva,Thickness[0.008]}],
Graphics[{
If[typzrcadla=="Duté",
{barva,Thickness[0.3 velikostf],zrcadlodute},
{barva,Thickness[0.3 velikostf],zrcadlovypukle}],
If[zobrazithlavnirovinu,
{barva,Dashed,Thickness[0.1 velikostf],hlavnirovinazrcadla},
Text[""]],
If[zobrazitohniska,
{{barvaf,PointSize[velikostf],ohnisko1},
{barvastred,PointSize[velikostf],stredkrivosti},
Text[Style["F",20,barvaf,FontFamily->Times,Bold],{stredx-znamenko f,-0.8}],
Text[Style["S",20,barvastred,FontFamily->Times,Bold],{stredx-2znamenko f,-0.8}]},
Text[""]],
{barvaa,Thickness[0.2 velikostf],vzorsipka},
If[areseni≠{},
{If[zobrazitpaprsky,
If[-aobraz>0,
{{barvap1,Thickness[0.002],paprsek11},
{barvap1,Thickness[0.002],paprsek12},
{barvap3,Thickness[0.002],paprsek31},
{barvap3,Thickness[0.002],paprsek32},
If[a≠-aobraz,
{{barvap2,Thickness[0.002],paprsek21},
{barvap2,Thickness[0.002],paprsek22}},
Text[""]]},
{{barvap1,Thickness[0.002],paprsek11},
{barvap3,Thickness[0.002],paprsek31},
If[typzrcadla=="Duté",
{{barvap1,Thickness[0.002],Dashed,paprsek12},
{barvap1,Thickness[0.002],paprsek13},
{barvap2,Thickness[0.002],paprsek23},
{barvap2,Thickness[0.002],Dashed,paprsek24},
{barvap2,Thickness[0.002],paprsek25},
{barvap3,Thickness[0.002],Dashed,paprsek32},
{barvap3,Thickness[0.002],Dashed,paprsek33},
{barvap3,Thickness[0.002],paprsek34}},
{{barvap1,Thickness[0.002],paprsek14},
{barvap1,Thickness[0.002],Dashed,paprsek15},
{barvap2,Thickness[0.002],paprsek22},
{barvap2,Thickness[0.002],Dashed,paprsek26},
{barvap2,Thickness[0.002],paprsek27},
{barvap3,Thickness[0.002],Dashed,paprsek35},
{barvap3,Thickness[0.002],paprsek36},
{barvap3,Thickness[0.002],Dashed,paprsek32}}]
}],
Text[""]],
{barvaobraz,Thickness[0.2 velikostf],obrazsipka},
If[zobrazittext,
{Text[Style[StringJoin["f = ",ToString[Round[znamenko f,0.01]]," m"],15,barvaf,FontFamily->Times,Bold],{x1,-6},{Left,Center}],
Text[Style[StringJoin["a = ",ToString[Round[a,0.01]]," m"],15,barvaa,FontFamily->Times,Bold],{x1,-6-deltayvypis},{Left,Center}],
Text[Style[StringJoin["y = ",ToString[Round[yvzor,0.01]]," m"],15,barvaa,FontFamily->Times,Bold],{x1,-6-2 deltayvypis},{Left,Center}],
Text[Style[StringJoin["a' = ",ToString[Round[-aobraz,0.01]]," m"],15,barvaobraz,FontFamily->Times,Bold],{0.6x1,-6-deltayvypis},{Left,Center}],
Text[Style[StringJoin["y' = ",ToString[Round[yobraz,0.01]]," m"],15,barvaobraz,FontFamily->Times,Bold],{0.6x1,-6-2 deltayvypis},{Left,Center}],
Text[Style[StringJoin["Z = ",ToString[Round[(yobraz/yvzor),0.01]]],15,barva,FontFamily->Times,Bold],{0.2x1,-6-deltayvypis},{Left,Center}]},
Text[""]],
If[zobrazitvlastnosti,
{Text[Style["Obraz je:",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6},{Left,Center}],
If[aobraz<0,
Text[Style["- skutečný (reálný)",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-deltayvypis},{Left,Center}],
Text[Style["- neskutečný (zdánlivý)",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-deltayvypis},{Left,Center}]],
If[Abs[(yobraz/yvzor)]>1,
Text[Style["- zvětšený",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-2deltayvypis},{Left,Center}],
If[Abs[(yobraz/yvzor)]<1,
Text[Style["- zmenšený",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-2deltayvypis},{Left,Center}],
Text[Style["- stejně vysoký jako vzor",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-2deltayvypis},{Left,Center}]]],
If[yobraz>0,
Text[Style["- přímý (nepřevrácený)",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-3deltayvypis},{Left,Center}],
Text[Style["- převrácený",15,barvaobraz,FontFamily->Times,Bold],{0.2x2,-6-3deltayvypis},{Left,Center}]]},
Text[""]]},
If[zobrazittext,
Text[Style["O B R A Z   V Z N I K Á   V   N E K O N E Č N U!!!",20,barva,FontFamily->Times,Bold],{stredx,-6-deltayvypis},{Center,Center}],
Text[""]]]
}],
FormatType->StandardForm,
Axes->False,AxesOrigin->{0,0},PlotRange->{{x1,x2},{y1-deltay,y2}},ImageSize->520
]],

{{f,1.5,Style["f",20,barvaf,FontFamily->Times,Italic]},1.3,fmax,0.1},
{{a,2,Style["a",20,barvaa,FontFamily->Times,Italic]},0.5,amax,0.1},
{{yvzor,2,Style["y",20,barvaa,FontFamily->Times,Italic]},0.5,0.9ymax,0.1},
Delimiter,
{{typzrcadla,"Duté",Style["typ zrcadla",15,barva,FontFamily->Times]},{"Duté","Vypuklé"}},
Delimiter,
Item[Style["zobrazit",15,barva,FontFamily->Times],Alignment->Left],
{{zobrazithlavnirovinu,True,Item[Style["- hlavní rovinu",15,barva,FontFamily->Times],Alignment->Left]},{True,False},ControlType->Checkbox},
{{zobrazitpaprsky,True,Style["- paprsky",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitohniska,True,Style["- ohniska",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazittext,True,Style["- hodnoty",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitvlastnosti,True,Style["- vlastnosti",15,barva,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, 2008",10,Black,FontFamily->Times],"",Style["Zobrazení kulovým zrcadlem",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.

Zrcadla