Zobrazení čočkou

Následující aplet umožňuje názorně pochopit zobrazení předmětu spojnou i rozptylnou čočkou. Pomocí posuvníků lze nastavit libovolnou kombinaci ohniskové vzdálenosti f, vzdálenosti a vzoru od čočky a výšky y vzoru. Předdefinované rozsahy koeficientů může uživatel znalý Mathematicy měnit. Lze vybírat mezi zobrazením spojnou nebo rozptylnou čočkou, nastavit výpis dopočítávaných veličin a 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="cocka_.jpg";
cesta=NotebookDirectory[];
pocetulozeni=0;
x1=-10;x2=10;
y1=-5;y2=5;
stredx=0;stredy=0;
deltay=4;
deltayvypis=0.8;

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

delka=0.8;(*Délka ramena vzoru "F".*)
velikostf=0.02;
sipkapaprsek=0.02;

cockas1={{0.05 x1,0.8y2},{stredx,0.95y2},{0.05 x2,0.8y2}};
cockas2={{stredx,0.94y2},{stredx,0.94y1}};
cockas3={{0.05 x1,0.8y1},{stredx,0.95y1},{0.05 x2,0.8y1}};

cockar1={{0.05 x1,0.95y2},{stredx,0.8y2},{0.05 x2,0.95y2}};
cockar2={{stredx,0.79y2},{stredx,0.79y1}};
cockar3={{0.05 x1,0.95y1},{stredx,0.8y1},{0.05 x2,0.95y1}};

cockaspojka={
Line[cockas1],
Line[cockas2],
Line[cockas3]};
cockarozptylka={
Line[cockar1],
Line[cockar2],
Line[cockar3]};

Cocka=Manipulate[
ohnisko1=Point[{-f,stredy}];
ohnisko2=Point[{f,stredy}];
vzorsipka={
Arrowheads[{0,0.025}],
Arrow[{{-a,stredy},{-a,yvzor}}]};
obrazsipka={
Arrowheads[{0,0.025}],
Arrow[{{aobraz,stredy},{aobraz,yobraz}}]};
If[typcocky=="Spojka",
{znamenko=1,
textf1="F",
textf2="F'"},
{znamenko=-1,
textf1="F'",
textf2="F"}];
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},{znamenko f,stredy}}]},
paprsek14={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{stredx,yvzor},{f,2yvzor}}]},
paprsek15=Line[{{stredx,yvzor},{znamenko f,stredy}}],
paprsek21={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{-a,yvzor},{stredx,stredy}}]},
paprsek22=Line[{{stredx,stredy},{aobraz,yobraz}}],
paprsek23=Line[{{-a,yvzor},{aobraz,yobraz}}],
paprsek24={
Arrowheads[{0,sipkapaprsek}],
Arrow[{{stredx,stredy},{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},{x2,yobraz}}]}},
""];

grafik=Deploy[Show[
Plot[{0},{x,x1,x2},PlotStyle->{barva,Thickness[0.008]}],
Graphics[{
If[typcocky=="Spojka",
{barva,Thickness[0.3 velikostf],cockaspojka},
{barva,Thickness[0.3 velikostf],cockarozptylka}],
If[zobrazitohniska,
{{barvaf,PointSize[velikostf],ohnisko1},
{barvaf,PointSize[velikostf],ohnisko2},
Text[Style[textf1,20,barvaf,FontFamily->Times,Bold],{-f,-0.8}],
Text[Style[textf2,20,barvaf,FontFamily->Times,Bold],{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},
{barvap2,Thickness[0.002],paprsek21},
{barvap2,Thickness[0.002],paprsek22},
{barvap3,Thickness[0.002],paprsek31},
{barvap3,Thickness[0.002],paprsek32}},
{{barvap1,Thickness[0.002],paprsek11},
{barvap1,Thickness[0.002],Dashed,paprsek12},
If[typcocky=="Spojka",
{barvap1,Thickness[0.002],paprsek13},
{{barvap1,Thickness[0.002],paprsek14},
{barvap1,Thickness[0.002],Dashed,paprsek15}}],
{barvap2,Thickness[0.002],paprsek21},
{barvap2,Thickness[0.002],Dashed,paprsek23},
{barvap2,Thickness[0.002],paprsek24},
{barvap3,Thickness[0.002],paprsek31},
{barvap3,Thickness[0.002],Dashed,paprsek32},
{barvap3,Thickness[0.002],Dashed,paprsek33},
{barvap3,Thickness[0.002],paprsek34}}],
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,Style["f",20,barvaf,FontFamily->Times,Italic]},0.4,fmax,0.1},
{{a,2,Style["a",20,barvaa,FontFamily->Times,Italic]},0.4,amax,0.1},
{{yvzor,2,Style["y",20,barvaa,FontFamily->Times,Italic]},0.5,0.9ymax,0.1},
Delimiter,
{{typcocky,"Spojka",Style["typ čočky",15,barva,FontFamily->Times]},{"Spojka","Rozptylka"}},
Delimiter,
{{zobrazitpaprsky,True,Style["zobrazit paprsky",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitohniska,True,Style["zobrazit ohniska",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazittext,True,Style["zobrazit hodnoty",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitvlastnosti,True,Style["zobrazit 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í čočkou",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.

Cocka