Light Rays in a Lens

Manipulate[
Module[{h=2.5,head,radius,lfocusloc,rfocusloc,imgloc,objdist},
            (*Опис*)
imagedistance[foclength_,objdistance_]:=
If[lenstype=="converging",
If[ptobj[[1]]==rfocusloc[[1]]||ptobj[[1]]==lfocusloc[[1]]||objdistance==0,0,Solve[1/foclength == 1/objdistance + 1/q,q][[1,1,2]]],If[ptobj[[1]]==rfocusloc[[1]]||ptobj[[1]]==lfocusloc[[1]]||objdistance==0,0,Solve[1/-foclength == 1/objdistance + 1/q,q][[1,1,2]]]];
magnification[imgdistance_,objdistance_]:=If[ptobj[[1]]==rfocusloc[[1]]||ptobj[[1]]==lfocusloc[[1]]||objdistance==0||imgdistance==0,0,imgdistance/objdistance];
            (*Розрахунок*)
radius =7focus;
lfocusloc = {-focus+location[[1]],0};
rfocusloc = {focus+location[[1]],0};
objdist =Abs[location[[1]]-ptobj[[1]]];
imgloc = If[ptobj[[1]]<location[[1]],{location[[1]]+imagedistance[focus,objdist],magnification[-1*imagedistance[focus,objdist],objdist]*Last[ptobj]},{location[[1]]-imagedistance[focus,objdist],magnification[-1*imagedistance[focus,objdist],objdist]*Last[ptobj]}];
head=Graphics[Line[{{-1/2,1/4},{0,0},{-1/2,-1/4}}]];
source[{x0_,y0_},r0_]:={Orange,Disk[{x0,y0},r0],Line[{{x0,y0},{x0+2r0,y0}}],Line[{{x0,y0},{x0-2r0,y0}}],Line[{{x0,y0},{x0,y0+2r0}}],Line[{{x0,y0},{x0,y0-2r0}}],Line[{{x0,y0},{x0-1.6r0,y0-1.6r0}}],Line[{{x0,y0},{x0+1.6r0,y0-1.6r0}}],Line[{{x0,y0},{x0-1.6r0,y0+1.6r0}}],Line[{{x0,y0},{x0+1.6r0,y0+1.6r0}}]};
line2[{{x1_,y1_},{x2_,y2_}},{x3_,x4_}]:=Line[{{x3,(y2-y1)/(x2-x1)x3+(x2 y1-x1 y2)/(x2-x1)},{x4,(y2-y1)/(x2-x1)x4+(x2 y1-x1 y2)/(x2-x1)}}];(*лінія з початком в т.3, закінченням в т.4  і проходить через точки 1 і 2*)
arrow2[{{x1_,y1_},{x2_,y2_}},{x3_,x4_}]:=Arrow[{{x3,(y2-y1)/(x2-x1)x3+(x2 y1-x1 y2)/(x2-x1)},{x4,(y2-y1)/(x2-x1)x4+(x2 y1-x1 y2)/(x2-x1)}}];(*стрілка з початком в т.3, закінченням в т.4  і проходить через точки 1 і 2*)
(*Побудова Графічного зображення*)

Graphics[
(*Перевірка типу лінзи*)
If[lenstype=="converging",
{(*Для збиральної лінзи*)
(*ліва частина збир.лінзи*)
{Thick,LightGray,Circle[{First[location]+Sqrt[radius^2-h^2],0},radius,{Pi - ArcTan[h/Sqrt[radius^2-h^2]],Pi + ArcTan[h/Sqrt[radius^2-h^2]]}]},
(*права частина збир.лінзи*)
{Thick,LightGray,Circle[{location[[1]]-Sqrt[radius^2-h^2],0},radius,{-ArcTan[h/Sqrt[radius^2-h^2]],ArcTan[h/Sqrt[radius^2-h^2]]}]},
 (*схематичне зображення збир.лінзи*)
{Arrowheads[{{Automatic,Automatic,head}}],Thick,Arrow[{{location[[1]],0},{location[[1]],1.3h}}]},
{Arrowheads[{{Automatic,Automatic,head}}],Thick,Arrow[{{location[[1]],0},{location[[1]],-1.3h}}]},

{PointSize[Large],Red,Point[rfocusloc]},(*точка правого фокуса*)
Text[Style["F",FontSize->14,Italic,FontColor->Red],rfocusloc+.2],
{PointSize[Large],Red,Point[lfocusloc]},(*точка лівого фокуса*)
(*предмет*)
If[Abs[ptobj[[2]]]>0.02h,{Arrowheads[Large],Thick,Blue,Arrow[{{ptobj[[1]],0},ptobj}]},source[ptobj,0.15]],

{Thick,Line[{{-5,0},{5,0}}]},
Line[{{location[[1]],-h},{location[[1]],h}}],(*оптична вісь*)
{
If [ray1,(*промінь від предмета до лінзи паралельний оптичній осі*)
{{Arrowheads[Medium],Brown,Arrow[{ptobj,{location[[1]],ptobj[[2]]}}]},
If[Abs[ptobj[[1]]-location[[1]]]<Abs[focus],{{Brown,Dashed,Line[{{location[[1]],ptobj[[2]]},imgloc}]},{Arrowheads[Medium],Brown,Arrow[{{location[[1]],ptobj[[2]]},
If[ptobj[[1]]<location[[1]],rfocusloc,lfocusloc]}]}},{Arrowheads[Medium],Brown,Arrow[{{location[[1]],ptobj[[2]]},imgloc}]}]},
{}],

If [ray2,(*лінія від предмета до зображення через центр лінзи*)
If[Abs[ptobj[[1]]-location[[1]]]>Abs[focus],{Arrowheads[Medium],Pink,Arrow[{ptobj,imgloc}]},{{Pink,Dashed,Line[{ptobj,imgloc}]},{Arrowheads[Medium],Pink,Arrow[{ptobj,2location-ptobj}]}}],
{}],

If [ray3,(*лінія від предмета до лінзи через фокус*)
{If[Abs[ptobj[[1]]-location[[1]]]<Abs[focus],{{Arrowheads[Medium],Darker[Green,.6],Arrow[{ptobj,{location[[1]],imgloc[[2]]}}]},{Arrowheads[Medium],Darker[Green,.6],Arrow[{{location[[1]],imgloc[[2]]},{If[ptobj[[1]]>location[[1]]&&imgloc[[1]]>location[[1]],lfocusloc[[1]], rfocusloc[[1]]],imgloc[[2]]}}]},{Darker[Green,.6],Dashed,Line[{{location[[1]],imgloc[[2]]},imgloc}]}},
{
{Arrowheads[Medium],Darker[Green,.6],Arrow[{{location[[1]],imgloc[[2]]},imgloc}]},
{Arrowheads[Medium],Darker[Green,.6],Arrow[{ptobj,{location[[1]],imgloc[[2]]}}]}}]
},
{}],
(*зображення*)
If[Abs[ptobj[[2]]]>0.02h,If[Abs[ptobj[[1]]-location[[1]]]<Abs[focus],{Arrowheads[Large],Thick,Dashed,Blue,Arrow[{{imgloc[[1]],0},imgloc}]},{Arrowheads[Large],Thick,Blue,Arrow[{{imgloc[[1]],0},imgloc}]}],source[imgloc,0.12]]
},
(*побудова променів за допомогою побічного фокуса*)
If[Abs[ptobj[[2]]]<0.02 h&&ptobj[[1]]<location[[1]],{{Red,Dashed,Line[{{rfocusloc[[1]],-h},{rfocusloc[[1]],h}}]},
{PointSize[Large],Red,Point[{rfocusloc[[1]],h/3}]},(*точка правого побічного фокуса*)
Text[Style["F'",FontSize->14,Italic,FontColor->Red],{rfocusloc[[1]],h/3}+.2],

(*побудова побічної оптичної вісі*)
{line2[{{lfocusloc[[1]],-h/3},{rfocusloc[[1]],h/3}},{-2focus+location[[1]],2focus+location[[1]]} ]},
(*побудова променя, що проходить через правий побічний фокус *)
{Arrowheads[Medium],Darker[Green],Arrow[{ptobj,{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])}}]},If[imgloc[[1]]>0 ,{Arrowheads[Medium],Darker[Green],Arrow[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},imgloc}]},{{Darker[Green],Dashed,Line[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},imgloc}]}, {Arrowheads[Medium],Darker[Green],Arrow[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},{rfocusloc[[1]],h/3}}]}}]
},
{}],
If[Abs[ptobj[[2]]]<0.02 h&&ptobj[[1]]>location[[1]],{{Red,Dashed,Line[{{lfocusloc[[1]],-h},{lfocusloc[[1]],h}}]},
{PointSize[Large],Red,Point[{lfocusloc[[1]],-h/3}]},(*точка лівого побічного фокуса*)
Text[Style["F'",FontSize->14,Italic,FontColor->Red],{lfocusloc[[1]],-h/3}+.2],
(*побудова побічної оптичної вісі*)
{line2[{{lfocusloc[[1]],-h/3},{rfocusloc[[1]],h/3}},{-2focus+location[[1]],2focus+location[[1]]} ]},
{Arrowheads[Medium],Darker[Green],Arrow[{ptobj,{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])}}]},
If[imgloc[[1]]<0,{Arrowheads[Medium],Darker[Green],Arrow[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},imgloc}]},{{Arrowheads[Medium],Darker[Green],Arrow[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},{lfocusloc[[1]],-h/3} }]},{Darker[Green],Dashed,Line[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},imgloc}]}}]
},
{}]
},
{(*Для розсіювальної лінзи*)
{Thick,LightGray,Circle[{radius/(Cos[ArcTan[h/Sqrt[radius^2-h^2]]])+location[[1]],0},radius,{Pi- ArcTan[h/Sqrt[radius^2-h^2]],Pi+ArcTan[h/Sqrt[radius^2-h^2]]}]},(*ліва частина розс.лінзи*)

{Thick,LightGray,Circle[{-radius/(Cos[ArcTan[h/Sqrt[radius^2-h^2]]])+location[[1]],0},radius,{-ArcTan[h/Sqrt[radius^2-h^2]],ArcTan[h/Sqrt[radius^2-h^2]]}]},
                                                                (*права частина розс.лінзи*)
{Thick,LightGray,(*верхня частина розс.лінзи*)Line[{{radius/(Cos[ArcTan[h/Sqrt[radius^2-h^2]]]) - Sqrt[radius^2-h^2]+location[[1]],h},{-(radius/(Cos[ArcTan[h/Sqrt[radius^2-h^2]]]) - Sqrt[radius^2-h^2])+location[[1]],h}}]},

{Thick,LightGray,(*нижня частина розс.лінзи*)Line[{{radius/(Cos[ArcTan[h/Sqrt[radius^2-h^2]]]) - Sqrt[radius^2-h^2]+location[[1]],-h},{-(radius/(Cos[ArcTan[h/Sqrt[radius^2-h^2]]]) - Sqrt[radius^2-h^2])+location[[1]],-h}}]},
{Arrowheads[{{0.05,0,head}}],Thick,Arrow[{{location[[1]],1.3h},{location[[1]],0}}]},
{Arrowheads[{{0.05,0,head}}],Thick,Arrow[{{location[[1]],-1.3h},{location[[1]],0}}]},

{PointSize[Large],Red,Point[rfocusloc]},(*точка правого фокуса*)
Text[Style["F",FontSize->14,Italic,FontColor->Red],rfocusloc+.2],
{PointSize[Large],Red,Point[lfocusloc]},(*точка лівого фокуса*)
(*предмет*)
If[Abs[ptobj[[2]]]>0.02h,{Arrowheads[Large],Thick,Blue,Arrow[{{ptobj[[1]],0},ptobj}]},source[ptobj,0.15]],

{Thick,Line[{{-5,0},{5,0}}]},
Line[{{location[[1]],-h},{location[[1]],h}}],(*оптична вісь*)

(*зображення*)
If[Abs[ptobj[[2]]]>0.02h,{Arrowheads[Large],Thick,Dashed,Blue,Arrow[{{imgloc[[1]],0},imgloc}]},source[imgloc,0.12]],

If [ray1,{
{Arrowheads[Medium],Brown,Arrow[{ptobj,{location[[1]],ptobj[[2]]}}]},
If[ptobj[[1]]<location[[1]],{{Arrowheads[Medium],Brown,arrow2[{{location[[1]],ptobj[[2]]},lfocusloc},{location[[1]],rfocusloc[[1]]}]},
{Brown,Dashed,Line[{{location[[1]],ptobj[[2]]},lfocusloc}]}},{{Arrowheads[Medium],Brown,arrow2[{{location[[1]],ptobj[[2]]},rfocusloc},{location[[1]],lfocusloc[[1]]}]},
{Brown,Dashed,Line[{{location[[1]],ptobj[[2]]},rfocusloc}]}}]
},
{}],
If [ray2,
{Arrowheads[Medium],Pink,arrow2[{ptobj,imgloc},{ptobj[[1]],If[ptobj[[1]]<location[[1]],rfocusloc[[1]],lfocusloc[[1]]]}]},
{}],
If [ray3,{
If[ptobj[[1]]<location[[1]],{{Arrowheads[Medium],Darker[Green,.6],arrow2[{ptobj,rfocusloc},{ptobj[[1]],location[[1]]}]},{Arrowheads[Medium],Darker[Green,.6],Arrow[{{location[[1]],imgloc[[2]]},{rfocusloc[[1]],imgloc[[2]]}}]}},{{Arrowheads[Medium],Darker[Green,.6],arrow2[{ptobj,lfocusloc},{ptobj[[1]],location[[1]]}]},{Arrowheads[Medium],Darker[Green,.6],Arrow[{{location[[1]],imgloc[[2]]},{lfocusloc[[1]],imgloc[[2]]}}]}}],
{Darker[Green,.6],Dashed,Line[{{location[[1]],imgloc[[2]]},imgloc}]}
},
{}],
(*побудова променів за допомогою побічного фокуса*)
If[Abs[ptobj[[2]]]<0.02 h,If[ptobj[[1]]<location[[1]],(*предмет зліва*){{Red,Dashed,Line[{{lfocusloc[[1]],-h},{lfocusloc[[1]],h}}]},
{PointSize[Large],Red,Point[{lfocusloc[[1]],-h/3}]},(*точка лівого побічного фокуса*)
Text[Style["F'",FontSize->14,Italic,FontColor->Red],{lfocusloc[[1]]+.2,-h/3-.2}],
(*побудова побічної оптичної вісі*)
{line2[{{lfocusloc[[1]],-h/3},{rfocusloc[[1]],h/3}},{-2focus+location[[1]],2focus+location[[1]]} ]},
{Arrowheads[Medium],Darker[Green],Arrow[{ptobj,{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])}}]},
{Darker[Green],Dashed,Line[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},{lfocusloc[[1]],-h/3}}]},{Arrowheads[Medium],Darker[Green],arrow2[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},{lfocusloc[[1]],-h/3}},{location[[1]],rfocusloc[[1]]}]}
},
      (*предмет справа*)
{{Red,Dashed,Line[{{rfocusloc[[1]],-h},{rfocusloc[[1]],h}}]},
{PointSize[Large],Red,Point[{rfocusloc[[1]],h/3}]},(*точка лівого побічного фокуса*)
Text[Style["F'",FontSize->14,Italic,FontColor->Red],{rfocusloc[[1]]+.2,h/3+.2}],
(*побудова побічної оптичної вісі*)
{line2[{{lfocusloc[[1]],-h/3},{rfocusloc[[1]],h/3}},{-2focus+location[[1]],2focus+location[[1]]} ]},
{Arrowheads[Medium],Darker[Green],Arrow[{ptobj,{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])}}]},
{Arrowheads[Medium],Darker[Green],arrow2[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},{rfocusloc[[1]],h/3}},{location[[1]],lfocusloc[[1]]}]},{Darker[Green],Dashed,Line[{{location[[1]],h/3/focus(location[[1]]-ptobj[[1]])},{rfocusloc[[1]],h/3}}]}
}],{}]
}(*End розсіювальна лінза Graphics*)

],(*End If*)

(*Опції Графіка*)
ImageSize->{550,400},Axes->axes,PlotRange->{{-5,5},{-3.5,3.5}},ImagePadding->{{10,10},{0,40}},
PlotLabel->Style[Column[{If[Last[ptobj]==0,"  ",Text["The linear lens magnification is "<>ToString[Abs[Round[magnification[-1*imagedistance[focus,objdist],objdist],.01]]]<>".   The image is "<>If[magnification[-1*imagedistance[focus,objdist],objdist]>0,"virtual.","real."]]]}],FontSize->14]

](*End Graphics*)
],(*End Module*)

(*інструменти для керування*)
{{lenstype,"converging","lens type"},{"converging","diverging"}},
{{focus,1.5,"focal length"},1.0,2.5,Appearance->"Labeled"},
{{ptobj,{-5,2}},{-5,-2},{5,2},Locator},{{location,{0,0}},{-5,0},{5,0},Locator},
{{axes,False,"coordinates"},{True,False}},
{{ray1,True,"ray 1"},{True,False}},
{{ray2,True,"ray 2"},{True,False}},
{{ray3,True,"ray 3"},{True,False}},
Button["reset to default values",lenstype = "converging";focus = 1.5;ptobj = {-5,2};location = {0,0};],

TrackedSymbols:>Manipulate
]

CAPTION

This Demonstration shows the path of light rays passing through a convex or concave lens.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Light Rays in a Lens" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/LightRaysInALens/

Contributed by: Volodymyr Holovatsky (Chernivtsi National University, Ukraine)

A full-function Wolfram Mathematica system (Version 6 or higher) is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »