Ray Diagrams for Spherical Mirrors

Manipulate[
Module[{radius,objdistance,focusloc,imageloc,radiusloc,mirrorloc},

(*Definitons*)
imagedistance[foclength_,objdistance_]:=If[mirrortype =="concave",If[First[ptobj]==First[focusloc]||objdistance==0||foclength== objdistance,0,Solve[1/foclength==1/objdistance + 1/q,q][[1,1,2]]],If[First[ptobj]==First[focusloc]||objdistance==0||foclength== objdistance,0,Solve[1/-foclength==1/objdistance + 1/q,q][[1,1,2]]]];
magnification[objdistance_,imgdistance_]:=If[First[ptobj]==First[focusloc]||objdistance==0||imgdistance==0,0,imgdistance/objdistance];


(*Calculations*)
radius = 2focus;
objdistance = First[location]-First[ptobj];
focusloc = {(First[location]-radius)+focus,0};
imageloc = {First[location]-(imagedistance[focus,objdistance]),
magnification[objdistance,-1*imagedistance[focus,objdistance]]*Last[ptobj]};
mirrorloc = If[mirrortype=="concave",{Sqrt[radius^2 - (Last[ptobj])^2]+First[location]-radius,Last[ptobj]},
{-Sqrt[radius^2 - (Last[ptobj])^2]+First[location]+radius,Last[ptobj]}];

(*Begin Graphics*)
Graphics[{
If[mirrortype=="concave",
{Thick,Circle[{First[location]-radius,0},radius,{-Pi/3,Pi/3}]},{Thick,Circle[{First[location]+radius,0},radius,{2Pi/3,4Pi/3}]}],

{Arrowheads[Small],ColorData["HTML","SlateBlue"],Arrow[{{First[ptobj],0},ptobj}]},
{Thick,Line[{{0,0},{20,0}}]},

If[First[ptobj]≥First[location]||First[ptobj]==First[focusloc],{},
{{RGBColor[1,.47,0],Line[{ptobj,mirrorloc}]},
{RGBColor[.6,.73,.36],Line[{ptobj,location,{First[ptobj],-Last[ptobj]}}]},

{Arrowheads[Small],ColorData["HTML","SlateBlue"],Dashed,Arrow[{{First[imageloc],0},imageloc}]},
{RGBColor[1,.47,0],Line[{mirrorloc,imageloc}]},

{RGBColor[1,.47,0],Line[{imageloc,{First[imageloc]-2*(First[mirrorloc]-First[imageloc]),Last[imageloc]-2*(Last[mirrorloc]-Last[imageloc])}}]},

{RGBColor[.6,.73,.36],Line[{location,imageloc}]}

}]
},

ImageSize->{450,350},PlotRange->{{0,20},{-6,6}},Axes->{False,False},
PlotLabel->
Column[{
If[First[ptobj]≥First[location]||First[ptobj]==First[focusloc],"",Text@Row[{"magnification = ",NumberForm[N@Abs[magnification[objdistance,imagedistance[focus,objdistance]]],{4,2}]}]],If[First[ptobj]≥First[location]||First[ptobj]==First[focusloc],"",Text@Row[{"This is a ",If[magnification[objdistance,imagedistance[focus,objdistance]]<0,"virtual, upright","real, inverted"]," image."}]]
}]

](*End Graphics*)

](*End Module*)

(*Controls*)
,{{mirrortype,"concave","mirror type"},{"concave","convex"}},{{focus,2,"focal length"},2,3.5,Appearance->"Labeled"},{{ptobj,{5,2},"object"},{0,-3},{20,3},Locator},{{location,{15,0},"location"},{0,0},{20,0},Locator},Button[Row[{"reset values"}],mirrortype = "concave";focus = 2;ptobj = {5,2};location = {15,0};],TrackedSymbols:>Manipulate

]

CAPTION

This Demonstration lets you visualize the ray diagrams for concave and convex spherical mirrors. By manipulating the object and mirror locations, you can create real or virtual images. The ray parallel to the principal axis and the ray that hits the center of the mirror are drawn.

DETAILS

Locators allow you to drag both the object and the mirror. You can change the focal length using a slider. The degree of magnification and nature (real or virtual) of the image are displayed.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Ray Diagrams for Spherical Mirrors" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/RayDiagramsForSphericalMirrors/

Contributed by: Ernest Lee

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 »