(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 7.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 149783, 4291] NotebookOptionsPosition[ 132717, 3858] NotebookOutlinePosition[ 143356, 4102] CellTagsIndexPosition[ 143212, 4095] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell["Math 421 \[FilledSmallCircle] Fall 2010", "Subsubtitle", CellChangeTimes->{{3.494774209*^9, 3.494774209359375*^9}}, TextAlignment->Center], Cell[CellGroupData[{ Cell["The Riemann sphere", "Subtitle", TextAlignment->Center, TextJustification->0], Cell["17 October 2010", "Subsubtitle", CellChangeTimes->{{3.49635675696875*^9, 3.49635676034375*^9}}, TextAlignment->Center], Cell["\<\ Copyright \[Copyright] 2004\[Dash]2010 by Murray Eisenberg. All rights \ reserved.\ \>", "SmallText", CellChangeTimes->{{3.494774214609375*^9, 3.494774215109375*^9}}, TextAlignment->Center, TextJustification->0], Cell[CellGroupData[{ Cell["Introduction", "Section", CellChangeTimes->{{3.493499537953125*^9, 3.493499540421875*^9}}], Cell[TextData[{ "This notebook shows how to use David Park's ", StyleBox["Presentations", FontFamily->"Times", FontWeight->"Plain", FontSlant->"Italic"], " add-on application to visualize the \"lifts\" of functions ", Cell[BoxData[ FormBox[ StyleBox[ RowBox[{ RowBox[{"f", ":", "\[DoubleStruckCapitalC]"}], "\[Rule]", "\[DoubleStruckCapitalC]"}], FontWeight->"Plain"], TraditionalForm]]], ". to the Riemann sphere ", Cell[BoxData[ FormBox["\[CapitalOmega]", TraditionalForm]], FormatType->"TraditionalForm"], ". The purpose of doing this is to allow us to understand through \ visualization the behavior of such a function ", Cell[BoxData[ FormBox["f", TraditionalForm]], FormatType->"TraditionalForm"], " \"", StyleBox["at infinity", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], "\", that is, the behavior of ", Cell[BoxData[ FormBox[ StyleBox[ RowBox[{"f", "(", "z", ")"}], FontWeight->"Plain"], TraditionalForm]], FormatType->"TraditionalForm"], " at complex numbers ", Cell[BoxData[ FormBox["z", TraditionalForm]], FormatType->"TraditionalForm"], " having very large modulus." }], "Text", ShowCellTags->False, CellChangeTimes->{{3.491058451234375*^9, 3.4910584870625*^9}, 3.4910585549375*^9, {3.49279786209375*^9, 3.492797896046875*^9}, { 3.494774358484375*^9, 3.494774378515625*^9}, {3.494774741*^9, 3.494774873921875*^9}, {3.49477504290625*^9, 3.494775049921875*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Prerequisites", "Section", CellChangeTimes->{{3.466616366328125*^9, 3.46661637828125*^9}, { 3.466616604453125*^9, 3.466616607390625*^9}}], Cell[CellGroupData[{ Cell[TextData[StyleBox["Mathematica", FontSlant->"Italic"]], "Subsection", CellChangeTimes->{{3.466616614109375*^9, 3.466616621015625*^9}}], Cell[TextData[{ "Most of this notebook requires David Park's ", StyleBox["Mathematica", FontSlant->"Italic"], " add-on application ", StyleBox["Presentations", FontSlant->"Italic"], "." }], "Text", CellChangeTimes->{{3.46661644090625*^9, 3.466616483484375*^9}, { 3.466616542578125*^9, 3.466616591375*^9}, {3.4666167129375*^9, 3.466616714296875*^9}, {3.490983043921875*^9, 3.490983044875*^9}, { 3.490984276765625*^9, 3.4909843116875*^9}, 3.4910591349375*^9}], Cell[TextData[{ StyleBox["Presentations", FontSlant->"Italic"], " should be loaded by evaluating the expression:\n\t", StyleBox["<<", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Italic"], StyleBox["Presentations", FontFamily->"Courier", FontWeight->"Plain"], StyleBox["`", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], "\nThat initialization is done below, in the ", ButtonBox["Initialization section", BaseStyle->"Hyperlink", ButtonData->"initialization"], ", below." }], "Text", CellChangeTimes->{{3.46661644090625*^9, 3.466616483484375*^9}, { 3.466616542578125*^9, 3.466616591375*^9}, {3.4666167129375*^9, 3.46661679353125*^9}, {3.4666168744375*^9, 3.466616901171875*^9}, { 3.4909830825*^9, 3.4909830910625*^9}, {3.490984498375*^9, 3.49098451746875*^9}, {3.491058732328125*^9, 3.491058740734375*^9}, 3.491058892734375*^9, {3.491058930921875*^9, 3.491059018609375*^9}, { 3.491059057390625*^9, 3.491059075953125*^9}, {3.49105918140625*^9, 3.49105918140625*^9}, {3.491059247640625*^9, 3.49105924765625*^9}, { 3.491059412859375*^9, 3.491059447375*^9}, {3.491059659734375*^9, 3.491059692453125*^9}, {3.49105976584375*^9, 3.491059767484375*^9}}, ParagraphSpacing->{0.5, 0.}], Cell[TextData[{ "You should already know about using ", StyleBox["Presentations", FontSlant->"Italic"], " to draw a \"two-panel plot\" of the domain and codomain of a complex \ function, including a Cartesian or polar grid and perhaps various other \ objects. See notebook ", StyleBox["VisualizingFunctions.nb", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], "." }], "Text", CellChangeTimes->{{3.4910597709375*^9, 3.4910599115*^9}, { 3.49247129434375*^9, 3.492471300390625*^9}, {3.49477440659375*^9, 3.4947744791875*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Mathematics", "Subsection", CellChangeTimes->{{3.46661662978125*^9, 3.466616631109375*^9}}], Cell[TextData[{ "You should already know the algebra of complex numbers and polar \ representation of complex numbers as well as the idea of a function ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", ":", "\[DoubleStruckCapitalC]"}], "\[Rule]", "\[DoubleStruckCapitalC]"}], TraditionalForm]]], ", that is, a complex-valued function of a complex variable. And you should \ have begun to become familiar with finding the images of certain subsets of ", Cell[BoxData[ FormBox["\[DoubleStruckCapitalC]", TraditionalForm]], FormatType->"TraditionalForm"], " under such a function." }], "Text", CellChangeTimes->{{3.466616634859375*^9, 3.46661670978125*^9}, { 3.49105958428125*^9, 3.4910595870625*^9}, {3.49105962053125*^9, 3.491059636984375*^9}, {3.4910599269375*^9, 3.4910599291875*^9}, { 3.4924712228125*^9, 3.492471275453125*^9}, {3.494774509609375*^9, 3.4947745360625*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Initialization", "Section", ShowGroupOpener->True, CellChangeTimes->{{3.4906339376875*^9, 3.49063394653125*^9}, { 3.490638317984375*^9, 3.49063833975*^9}, {3.490735161125*^9, 3.490735165125*^9}, 3.490984367984375*^9}, CellTags->"initialization"], Cell[TextData[{ "When you opened this notebook, it should have prompted you whether you want \ to evaluate Initialization Cells. You should have answered \ \[OpenCurlyDoubleQuote]yes.\[CloseCurlyDoubleQuote]\nIf you did not, then ", StyleBox["evaluate the following Input cell now", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], ". (Even if the cell was already evaluated, it won\[CloseCurlyQuote]t hurt \ if you evaluate it again.)" }], "Text", ShowGroupOpener->True, CellChangeTimes->{{3.490634229484375*^9, 3.49063436175*^9}, 3.490634682*^9, { 3.490634737515625*^9, 3.4906347940625*^9}, {3.490700557578125*^9, 3.49070056315625*^9}, 3.49073510265625*^9, 3.490735145640625*^9, { 3.491059504265625*^9, 3.4910595165*^9}}, ParagraphSpacing->{0.5, 0.}], Cell[BoxData[ RowBox[{"<<", "Presentations`"}]], "Input", ShowGroupOpener->True, InitializationCell->True, CellChangeTimes->{{3.49063458959375*^9, 3.490634598328125*^9}, { 3.490650191265625*^9, 3.49065019440625*^9}}] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Three-dimensional graphics with ", StyleBox["Presentations", FontSlant->"Italic"] }], "Section", CellChangeTimes->{{3.49480485946875*^9, 3.49480487384375*^9}}], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " provides built-in functions such as ", StyleBox["Plot3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " and ", StyleBox["Graphics3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " for creating displays of three-dimensional objects. However, we shall be \ using some specializedfunctions from ", StyleBox["Presentations", FontSlant->"Italic"], " to create 3D objects relevant to complex functions. Accordingly, we shall \ use also the ", StyleBox["Presentations", FontSlant->"Italic"], " function ", StyleBox["Draw3DItems", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain", FontColor->RGBColor[0, 0, 1]], " to actually display those 3D objects." }], "Text", CellChangeTimes->{{3.49480487640625*^9, 3.494805077578125*^9}, 3.494806129328125*^9}], Cell[TextData[{ "The syntax of ", StyleBox["Draw3DItems", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " is similar to that of ", StyleBox["Draw2D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ". To get a template, on the ", StyleBox["PresentationsPalette", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " open the ", StyleBox["Drawing", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " division, then the ", StyleBox["DrawingCube", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " section, and finally the ", StyleBox["Graphics3D", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " group of functions. Insert the template:\n\t", Cell[BoxData[ FormBox[ StyleBox[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", TagBox[ FrameBox["primitives"], "Placeholder"], "}"}], ",", TagBox[ FrameBox["options"], "Placeholder"]}], "]"}], FontFamily->"Courier"], TraditionalForm]], FormatType->"TraditionalForm"] }], "Text", CellChangeTimes->{{3.49480487640625*^9, 3.494805224171875*^9}, 3.494805278359375*^9, {3.49480630665625*^9, 3.494806307390625*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ "For example, here is a 3D drawing of a surface along with some text, using \ the ", StyleBox["Presentations", FontSlant->"Italic"], " functions ", StyleBox["Draw3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " and ", StyleBox["Text3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ":" }], "Text", CellChangeTimes->{{3.49480487640625*^9, 3.494805179234375*^9}, { 3.49480532721875*^9, 3.49480533284375*^9}, {3.494806042203125*^9, 3.494806102453125*^9}}], Cell[BoxData[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.7", "]"}], ",", "\[IndentingNewLine]", RowBox[{"Draw3D", "[", RowBox[{ RowBox[{ RowBox[{ FractionBox["1", "2"], SuperscriptBox["y", "2"]}], "-", RowBox[{ FractionBox["1", "3"], SuperscriptBox["x", "2"]}]}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "3"}], ",", "3"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", "None"}]}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Text3D", "[", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "2"}], "}"}]}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"BoxRatios", "\[Rule]", "1"}], ",", "\[IndentingNewLine]", "NiceRotation", ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3", " ", "72"}]}]}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.494805335046875*^9, 3.494805464203125*^9}, { 3.494805494875*^9, 3.494805529453125*^9}, {3.4948055933125*^9, 3.494805643625*^9}, {3.494805768984375*^9, 3.49480590165625*^9}, { 3.49480595871875*^9, 3.494805974578125*^9}, {3.494861565203125*^9, 3.494861569171875*^9}}], Cell[TextData[{ "Contrary to common mathematical practice, even with the option ", StyleBox["Axes\[Rule]True", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ", no axes are drawn through the origin ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "0"}], ")"}], TraditionalForm]]], ". Instead, the 3D objects are shown inside a frame, and the tick marks and \ labels are placed along three edges of that frame." }], "Text", CellChangeTimes->{{3.49477563221875*^9, 3.49477571234375*^9}, { 3.49478329940625*^9, 3.49478332815625*^9}, {3.494806015125*^9, 3.494806018921875*^9}}], Cell[TextData[{ "As with any ", StyleBox["Mathematica", FontSlant->"Italic"], " 3D graphics, you can rotate the object and zoom in or out on it by using \ the usual mouse and keystroke methods." }], "Text", CellChangeTimes->{{3.494775736890625*^9, 3.4947757778125*^9}}], Cell[TextData[{ "The ", StyleBox["Presentations", FontSlant->"Italic"], " command ", StyleBox["NiceRotation", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain"], ", used above, prevents the image from jumping when you release the mouse \ after rotating the figure. " }], "Text", CellChangeTimes->{{3.494861585984375*^9, 3.49486164103125*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["The Riemann sphere", "Section"], Cell[TextData[{ "The ", StyleBox["Riemann sphere", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], " ", Cell[BoxData[ FormBox["\[CapitalOmega]", TraditionalForm]]], " is the sphere in ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]]], " of radius 1 centered at the point ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "0"}], ")"}], TraditionalForm]]], ". Thus the sphere's ", StyleBox["equator", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], " is the great circle consisting of all points ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], TraditionalForm]]], " satisfying ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], "=", "0"}], ",", " ", RowBox[{"z", "=", "0"}]}], TraditionalForm]]], ". And the ", StyleBox["north pole", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], " is the point ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "2"}], ")"}], TraditionalForm]]], "." }], "Text", CellChangeTimes->{{3.494774565171875*^9, 3.494774605484375*^9}, { 3.494774679265625*^9, 3.49477468375*^9}, {3.494774965015625*^9, 3.494774982046875*^9}, {3.494775103609375*^9, 3.494775194515625*^9}, { 3.494775296421875*^9, 3.49477537290625*^9}, {3.49485804853125*^9, 3.49485805771875*^9}}], Cell[TextData[{ "[Sometimes it is more convenient to use, instead, the sphere of radious 1 \ centered at ", Cell[BoxData[ FormBox[ StyleBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], FontWeight->"Plain"], TraditionalForm]]], ", so that the sphere is tangent to the ", Cell[BoxData[ FormBox[Cell[""], TraditionalForm]]], Cell[BoxData[ FormBox[ RowBox[{"x", "\[ThinSpace]", "y"}], TraditionalForm]], FormatType->"TraditionalForm"], "-plane at the origin ", Cell[BoxData[ FormBox[ StyleBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "0"}], ")"}], FontWeight->"Plain"], TraditionalForm]]], ".]" }], "Text", CellChangeTimes->{{3.494774565171875*^9, 3.494774605484375*^9}, { 3.494774679265625*^9, 3.49477468375*^9}, {3.494774965015625*^9, 3.494774982046875*^9}, {3.494775103609375*^9, 3.49477513159375*^9}, { 3.49477520971875*^9, 3.49477528328125*^9}, {3.494783181015625*^9, 3.49478320746875*^9}}], Cell[TextData[{ "The ", StyleBox["Presentations", FontSlant->"Italic"], " graphics primitive ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain"], " creates a three-dimensional graphic object that the ", StyleBox["Presentations", FontSlant->"Italic"], " function ", StyleBox["Draw3DItems", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " can then display. Because ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " is a function and not a geometric object, you must still use brackets in ", StyleBox["ColoredRiemannSphere[]", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ", even though you may call it, as in the next Input cell, with no arguments." }], "Text", CellChangeTimes->{{3.49477539340625*^9, 3.4947754571875*^9}, { 3.49478323565625*^9, 3.494783287375*^9}, {3.49480618075*^9, 3.494806220671875*^9}, {3.4948580849375*^9, 3.494858102265625*^9}}], Cell[BoxData[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{"ColoredRiemannSphere", "[", "]"}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], ",", "\[IndentingNewLine]", "NiceRotation"}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.494774927484375*^9, 3.494774947921875*^9}, 3.494784569140625*^9, {3.494861661703125*^9, 3.4948616646875*^9}}], Cell[TextData[{ "By default, ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " adds the equatorial circle and an arrow pointing outward from the north \ pole." }], "Text", CellChangeTimes->{{3.494783350953125*^9, 3.494783398109375*^9}, { 3.494806235453125*^9, 3.494806254703125*^9}, {3.494858131171875*^9, 3.494858135453125*^9}}], Cell[TextData[{ "The purpose of the option ", StyleBox["NiceRotation", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " in ", StyleBox["Draw3DItems", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " is to avoid jumps in the image as you release the mouse after rotating the \ image." }], "Text", CellChangeTimes->{{3.4960041739375*^9, 3.4960042490625*^9}}], Cell[CellGroupData[{ Cell["Changing the color of the Riemann sphere", "Subsection", CellChangeTimes->{{3.496003727234375*^9, 3.496003760078125*^9}}], Cell[TextData[{ "To change the color painted on the sphere, use ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " with an argument specifying the color:" }], "Text", CellChangeTimes->{{3.494775933328125*^9, 3.494775957234375*^9}, { 3.494783433484375*^9, 3.49478343796875*^9}}], Cell[BoxData[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.35", "]"}], ",", "\[IndentingNewLine]", RowBox[{"ColoredRiemannSphere", "[", RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], ",", "\[IndentingNewLine]", "NiceRotation"}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.494774927484375*^9, 3.494774947921875*^9}, { 3.49477597365625*^9, 3.494776028703125*^9}, 3.49478456484375*^9, { 3.494861675078125*^9, 3.494861682046875*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Changing other enhancements to the Riemann sphere", "Subsection", CellChangeTimes->{{3.49600374484375*^9, 3.49600379940625*^9}}], Cell[TextData[{ "If on ", StyleBox["PresentationsPalette", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " you open the ", StyleBox["Drawing", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " division, then the ", StyleBox["Complex Graphics", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " section, and finaally the ", StyleBox["Riemann", FontFamily->"Helvetica", FontWeight->"Plain", FontSlant->"Plain"], " group, you can insert a template for ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " into your notebook:\n\t", Cell[BoxData[ RowBox[{"ColoredRiemannSphere", "[", RowBox[{ TagBox[ FrameBox["color"], "Placeholder"], ",", TagBox[ FrameBox["radius"], "Placeholder"], ",", TagBox[ FrameBox["annotations"], "Placeholder"]}], "]"}]]] }], "Text", CellChangeTimes->{{3.494776058625*^9, 3.494776128546875*^9}, { 3.494776167671875*^9, 3.494776202515625*^9}, {3.494806273859375*^9, 3.494806297875*^9}, {3.494858164*^9, 3.49485817778125*^9}, { 3.49600377265625*^9, 3.496003773890625*^9}}, ParagraphSpacing->{0.5, 0.}], Cell[TextData[{ "We'll stick with a radius of 1\[LongDash]actually, a radius slightly less \ than 1, so that objects such as the equator can be drawn at radius exactly 1 \ and thereby seem to \"float\" on the surface of the sphere. However, we'll \ change the additional objects displayed. For example we are going to draw:\n\t\ \[FilledSmallCircle] the equator as a thick, blue ", StyleBox["Circle3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ";\n\t\[FilledSmallCircle] the \"Greenwich meridian\" as a thick blue \ semi-circle formed using ", StyleBox["Circle3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], "; and\n\t\[FilledSmallCircle] the north pole as a red ", StyleBox["Arrow3D", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ".\nWe also include a point on the Greenwich meridian among the geometric \ objects in the argument to ", StyleBox["Draw3DItems", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ". (You could include that, instead, as part of the ", StyleBox["annotations", FontFamily->"Helvetica", FontSize->12, FontWeight->"Plain", FontSlant->"Italic"], " argument to ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ".)" }], "Text", CellChangeTimes->{{3.49478347796875*^9, 3.4947835096875*^9}, { 3.494784179703125*^9, 3.494784236296875*^9}, {3.49478427675*^9, 3.494784282421875*^9}, {3.494784630765625*^9, 3.4947849565*^9}, { 3.494785590109375*^9, 3.494785628265625*^9}, {3.494786157953125*^9, 3.49478619353125*^9}, {3.49480633359375*^9, 3.494806388546875*^9}, { 3.494858202546875*^9, 3.4948582390625*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ "In the ", StyleBox["Presentations", FontSlant->"Italic"], " function ", StyleBox["Circle3D", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain"], ", the first argument is the circle's center; the second argument is a \ vector normal to the plane of the circle; the third argument is the radius of \ the circle; and the optional fourth argument is the angle range to use for \ the parameter used to draw the arc." }], "Text", CellChangeTimes->{{3.49478347796875*^9, 3.4947835096875*^9}, { 3.494784179703125*^9, 3.494784236296875*^9}, {3.49478427675*^9, 3.494784282421875*^9}, {3.494784630765625*^9, 3.494784985015625*^9}, { 3.494785411140625*^9, 3.494785484953125*^9}}], Cell[TextData[{ "In the ", StyleBox["Presentations", FontSlant->"Italic"], " function ", StyleBox["Arrow3D", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain"], ", the first two arguments are the locations of the arrow's tail and head, \ respectively; the third argument is the size of the cone drawn at the arrow's \ head, as a fraction of the overall arrow length; and the optional fourth \ argument gives graphics directives for the arrow's shaft." }], "Text", CellChangeTimes->{{3.49478347796875*^9, 3.4947835096875*^9}, { 3.494784179703125*^9, 3.494784236296875*^9}, {3.49478427675*^9, 3.494784282421875*^9}, {3.494784630765625*^9, 3.49478502453125*^9}, { 3.4947854935*^9, 3.494785555578125*^9}}], Cell[BoxData[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.35", "]"}], ",", "\[IndentingNewLine]", RowBox[{"ColoredRiemannSphere", "[", RowBox[{ RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], ",", "0.995", ",", "\[IndentingNewLine]", RowBox[{"{", "\[IndentingNewLine]", RowBox[{"Blue", ",", "Thick", ",", "\[IndentingNewLine]", RowBox[{"Circle3D", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}], ",", "1"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Circle3D", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "0", ",", "0"}], "}"}], ",", "1", ",", RowBox[{"{", RowBox[{"0", ",", "\[Pi]"}], "}"}]}], "]"}], ",", "\[IndentingNewLine]", "Red", ",", RowBox[{"Arrow3D", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1.35"}], "}"}], ",", RowBox[{"{", "0.75", "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"Thickness", "[", "0.02", "]"}], ",", RowBox[{"Legacy", "@", "DeepCadmiumRed"}]}], "}"}]}], "]"}]}], "\[IndentingNewLine]", "}"}]}], "]"}], ",", "\[IndentingNewLine]", "Black", ",", RowBox[{"PointSize", "[", "0.025", "]"}], ",", "\[IndentingNewLine]", RowBox[{"Point", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1", ",", "1"}], "}"}], "/", SqrtBox["2"]}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}]}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.494774927484375*^9, 3.494774947921875*^9}, { 3.49477597365625*^9, 3.494776028703125*^9}, {3.49477624146875*^9, 3.49477625471875*^9}, {3.494776289703125*^9, 3.494776290796875*^9}, { 3.494783512921875*^9, 3.4947835618125*^9}, {3.494783610625*^9, 3.49478369725*^9}, 3.4947837605625*^9, {3.494783811203125*^9, 3.494783812921875*^9}, {3.494784006484375*^9, 3.494784018296875*^9}, 3.494784075421875*^9, 3.49478413009375*^9, 3.49478416140625*^9, { 3.494784252578125*^9, 3.4947842666875*^9}, {3.494784299515625*^9, 3.49478434415625*^9}, {3.4947844026875*^9, 3.494784552203125*^9}, 3.494784666375*^9, {3.49478506809375*^9, 3.494785347640625*^9}, { 3.494785381609375*^9, 3.49478538746875*^9}, {3.494785667203125*^9, 3.4947856759375*^9}, {3.494785899109375*^9, 3.494786043234375*^9}, { 3.494786085*^9, 3.494786110359375*^9}, {3.4947861423125*^9, 3.494786152453125*^9}, {3.4947862240625*^9, 3.4947862331875*^9}, { 3.49486168821875*^9, 3.4948617108125*^9}}] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Standard options for drawing the Riemann sphere: ", StyleBox["ViewRiemann", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain"] }], "Subsection", CellChangeTimes->{{3.49600381403125*^9, 3.4960038296875*^9}}], Cell[TextData[{ "The ", StyleBox["Presentations", FontSlant->"Italic"], " object ", StyleBox["ViewRiemann", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Plain"], " is a list of standard options that you may wish to use when drawing the \ Riemann sphere. These options specify the kind, color, and directions of \ lighting, and the point in space from which the sphere is viewed, among other \ things." }], "Text", CellChangeTimes->{{3.49477580103125*^9, 3.4947759095*^9}, { 3.494785755328125*^9, 3.494785762296875*^9}, 3.494806449546875*^9}], Cell[BoxData["ViewRiemann"], "Input", CellChangeTimes->{{3.494775842171875*^9, 3.494775843984375*^9}}], Cell[BoxData[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.35", "]"}], ",", "\[IndentingNewLine]", RowBox[{"ColoredRiemannSphere", "[", RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", "ViewRiemann"}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.494774927484375*^9, 3.494774947921875*^9}, { 3.494775590375*^9, 3.49477562096875*^9}, {3.494775794078125*^9, 3.494775795046875*^9}, {3.494806535734375*^9, 3.49480661140625*^9}, { 3.494806705671875*^9, 3.494806750734375*^9}}], Cell[TextData[{ "However, ", StyleBox["ViewRiemann", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " does not provide a suitable ", StyleBox["ViewPoint", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " in case you want to display axes and the entire bounding box. Moreover, ", StyleBox["ViewRiemann", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " also suppresses axes and a bounding box, so you have to include options ", StyleBox["Axes\[Rule]True", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " and ", StyleBox["Boxed\[Rule]True", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ", if you want the opposite settings." }], "Text", CellChangeTimes->{{3.49480661528125*^9, 3.494806651640625*^9}, { 3.494806763078125*^9, 3.494806942421875*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["The Riemann sphere with the complex plane", "Subsection", CellChangeTimes->{{3.4960038510625*^9, 3.496003859953125*^9}}], Cell[TextData[{ "In terms of Cartesian coordinates ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " in three-dimensional Euclidean space ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], ", the ", Cell[BoxData[ FormBox[ RowBox[{"x", " ", "y"}], TraditionalForm]], FormatType->"TraditionalForm"], "-plane having equation ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], " can be identified with two-dimensional Euclidean space ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "2"], TraditionalForm]], FormatType->"TraditionalForm"], " in the usual way. But as sets, ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "2"], TraditionalForm]], FormatType->"TraditionalForm"], " and the complex plane ", Cell[BoxData[ FormBox["\[DoubleStruckCapitalC]", TraditionalForm]], FormatType->"TraditionalForm"], " are the same. Thus we regard the complex plane ", Cell[BoxData[ FormBox["\[DoubleStruckCapitalC]", TraditionalForm]], FormatType->"TraditionalForm"], " as \"embedded\" as the plane ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], " in ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], "." }], "Text", CellChangeTimes->{{3.494860239171875*^9, 3.494860495671875*^9}}], Cell[TextData[{ "Here is a drawing of the Riemann sphere together with the complex plane \ embedded that way into ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]]], ". The drawing includes the real and imaginary axes on the complex plane." }], "Text", CellChangeTimes->{{3.49486106909375*^9, 3.49486111428125*^9}, { 3.494861217046875*^9, 3.494861239328125*^9}, {3.494861772875*^9, 3.49486178121875*^9}}], Cell[BoxData[ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.75", "]"}], ",", "\[IndentingNewLine]", RowBox[{"ColoredRiemannSphere", "[", RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Draw3D", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "0", "}"}], ",", RowBox[{"{", "0", "}"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Legacy", "@", "AlizarinCrimson"}]}]}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Background", "\[Rule]", RowBox[{"Legacy", "@", "Linen"}]}], ",", "\[IndentingNewLine]", "NiceRotation"}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.494774927484375*^9, 3.494774947921875*^9}, { 3.494775590375*^9, 3.49477562096875*^9}, {3.494775794078125*^9, 3.494775795046875*^9}, {3.494806535734375*^9, 3.49480661140625*^9}, { 3.494806705671875*^9, 3.494806750734375*^9}, {3.494860507890625*^9, 3.49486054028125*^9}, {3.4948606016875*^9, 3.4948606421875*^9}, { 3.494860697390625*^9, 3.4948609085625*^9}, {3.4948609396875*^9, 3.4948610306875*^9}, {3.494861138328125*^9, 3.49486119059375*^9}, { 3.49486125759375*^9, 3.4948613556875*^9}, {3.49486148446875*^9, 3.4948615026875*^9}, {3.494861534515625*^9, 3.494861540203125*^9}, 3.496004029375*^9, {3.496004395203125*^9, 3.49600439665625*^9}, { 3.49600450203125*^9, 3.496004502203125*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["The extended complex plane and stereographic projection", "Section", CellChangeTimes->{{3.49485833959375*^9, 3.494858354*^9}}], Cell[TextData[{ "The ", StyleBox["extended complex plane", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], " is the set ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox[" ", FontWeight->"Plain"], RowBox[{ StyleBox[ OverscriptBox["\[DoubleStruckCapitalC]", "^"], FontWeight->"Bold"], StyleBox["=", FontWeight->"Plain"], StyleBox[ RowBox[{"\[DoubleStruckCapitalC]", "\[Union]", RowBox[{"{", "\[Infinity]", "}"}]}], FontWeight->"Plain"]}]}], TraditionalForm]]], " consisting of the set \[DoubleStruckCapitalC] of all complex numbers along \ with one additional object called the \"point-at-infinity\" and denoted by ", Cell[BoxData[ FormBox[ StyleBox["\[Infinity]", FontWeight->"Plain"], TraditionalForm]]], "." }], "Text", CellChangeTimes->{{3.4947746110625*^9, 3.49477467140625*^9}, 3.494775030625*^9, {3.494858823578125*^9, 3.494858826078125*^9}, { 3.494859938171875*^9, 3.494859941265625*^9}}], Cell[CellGroupData[{ Cell["Why introduce the point-at-infinity?", "Subsection", CellChangeTimes->{{3.494859188296875*^9, 3.494859198296875*^9}}], Cell[TextData[{ "The reason for introducing the point-at-infinity is as a device for \ describing more simply the behavior of the values ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", "(", "z", ")"}], Cell[""]}], TraditionalForm]], FormatType->"TraditionalForm"], " of a function ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", ":", RowBox[{"U", "\[Subset]", "\[DoubleStruckCapitalC]"}]}], "\[Rule]", "\[DoubleStruckCapitalC]"}], TraditionalForm]], FormatType->"TraditionalForm"], " for complex numbers ", Cell[BoxData[ FormBox["z", TraditionalForm]], FormatType->"TraditionalForm"], " of large modulus. For example, define:" }], "Text", CellChangeTimes->{{3.494858440890625*^9, 3.4948585815*^9}, { 3.494858828875*^9, 3.49485883121875*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "z_", "]"}], ":=", FractionBox["1", "z"]}]], "Input", CellChangeTimes->{{3.494858549828125*^9, 3.494858564609375*^9}}], Cell["Then:", "Text", CellChangeTimes->{{3.49485861053125*^9, 3.494858617171875*^9}}], Cell[BoxData[ RowBox[{"Limit", "[", RowBox[{ RowBox[{"f", "[", "z", "]"}], ",", RowBox[{"z", "\[Rule]", "\[Infinity]"}]}], "]"}]], "Input", CellChangeTimes->{{3.49485859040625*^9, 3.494858598484375*^9}}], Cell[TextData[{ "We express that also by saying ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", "(", "z", ")"}], "\[Rule]", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], " as ", Cell[BoxData[ FormBox[ RowBox[{"z", "\[Rule]", "\[Infinity]"}], TraditionalForm]], FormatType->"TraditionalForm"], ". Mathematically, that means that, for each ", Cell[BoxData[ FormBox[ RowBox[{"\[Epsilon]", ">", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], ", no matter how small, there is some sufficiently large ", Cell[BoxData[ FormBox[ RowBox[{"M", ">", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], " such that, for all ", Cell[BoxData[ FormBox[ RowBox[{"z", "\[Element]", "\[DoubleStruckCapitalC]"}], TraditionalForm]], FormatType->"TraditionalForm"], ", if ", Cell[BoxData[ FormBox[ RowBox[{"|", "z", "|", RowBox[{">", "M"}]}], TraditionalForm]], FormatType->"TraditionalForm"], ", then ", Cell[BoxData[ FormBox[ RowBox[{"|", RowBox[{"f", "(", "z", ")"}], "|", RowBox[{"<", "\[Epsilon]"}]}], TraditionalForm]], FormatType->"TraditionalForm"], ". " }], "Text", CellChangeTimes->{{3.494858620328125*^9, 3.4948587895625*^9}}], Cell[TextData[{ "A much simpler way to express the same thing is to extend the domain of ", Cell[BoxData[ FormBox["f", TraditionalForm]], FormatType->"TraditionalForm"], " so as to include the point-at- infinity, define ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", "(", "\[Infinity]", ")"}], "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], ", and then say that ", Cell[BoxData[ FormBox["f", TraditionalForm]], FormatType->"TraditionalForm"], " is continuous \"at infinity\"." }], "Text", CellChangeTimes->{{3.494858796296875*^9, 3.49485891225*^9}}] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Embedding the complex plane into ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], "None", FormatType->"TraditionalForm"] }], "Subsection", CellChangeTimes->{{3.4963201468125*^9, 3.4963201668125*^9}, { 3.496322386015625*^9, 3.49632238621875*^9}}], Cell[TextData[{ "The following function maps each point ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", RowBox[{"x", "+", RowBox[{"\[ImaginaryI]", " ", "y"}]}]}], TraditionalForm]], FormatType->"TraditionalForm"], " in the complex plane to a corresponding point ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"x", ",", "y", ",", "0"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " on the plane in 3-space ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], " with equation ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], "." }], "Text", CellChangeTimes->{{3.496320172796875*^9, 3.496320245046875*^9}, 3.496322341921875*^9}], Cell[BoxData[ RowBox[{ RowBox[{"embed", "[", "z_", "]"}], ":=", RowBox[{"Append", "[", RowBox[{ RowBox[{"ToCoordinates", "[", "z", "]"}], ",", "0"}], "]"}]}]], "Input", CellChangeTimes->{{3.4961009445625*^9, 3.49610096621875*^9}}], Cell["For example:", "Text", CellChangeTimes->{{3.496101029984375*^9, 3.496101032421875*^9}, { 3.49632027921875*^9, 3.49632028025*^9}}], Cell[BoxData[ RowBox[{"embed", "[", RowBox[{ RowBox[{"-", "2"}], "-", "\[ImaginaryI]"}], "]"}]], "Input", CellChangeTimes->{{3.496100968375*^9, 3.49610097303125*^9}, { 3.496320502328125*^9, 3.496320502921875*^9}}], Cell[TextData[{ "Using this ", StyleBox["embedding", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], " of the complex plane into 3-space, we may think of the complex plane ", Cell[BoxData[ FormBox["\[DoubleStruckCapitalC]", TraditionalForm]], FormatType->"TraditionalForm"], " as if it were, in fact, the plane ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], " in ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], "." }], "Text", CellChangeTimes->{{3.496320303296875*^9, 3.496320344609375*^9}, { 3.496322351140625*^9, 3.496322368234375*^9}}], Cell[TextData[{ "Here, for example, is a figure showing a point and line in the complex \ plane along with the corresponding embedded point and line on the embedded \ plane ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], ". (In the definition of ", StyleBox["embeddedPlane", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ", the option ", StyleBox["Mesh\[Rule]{{0},{0}", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " draws lines ", Cell[BoxData[ FormBox[ RowBox[{"x", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], ", ", Cell[BoxData[ FormBox[ RowBox[{"y", "=", "0"}], TraditionalForm]], FormatType->"TraditionalForm"], ", in effect drawing axes in that plane.)" }], "Text", CellChangeTimes->{{3.49632034915625*^9, 3.496320388609375*^9}, { 3.49632092625*^9, 3.496321067140625*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"a", "=", RowBox[{ RowBox[{"-", "2.5"}], "-", RowBox[{"0.5", "\[ImaginaryI]"}]}]}], ";", RowBox[{"b", "=", RowBox[{"1", "-", RowBox[{"2.5", "\[ImaginaryI]"}]}]}], ";", RowBox[{"c", "=", RowBox[{ RowBox[{"-", "0.75"}], "-", RowBox[{"1.5", " ", "\[ImaginaryI]"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"ctr", "=", RowBox[{"1", "+", "\[ImaginaryI]"}]}], ";", RowBox[{"r", "=", "1"}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"onComplexPlane", "=", RowBox[{"Draw2D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{"Thick", ",", "Blue", ",", RowBox[{"ComplexLine", "[", RowBox[{"{", RowBox[{"a", ",", "b"}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"ComplexPoint", "[", "c", "]"}], ",", "\[IndentingNewLine]", "Thick", ",", RowBox[{"Darker", "@", "Brown"}], ",", RowBox[{"ComplexCircle", "[", RowBox[{"ctr", ",", "r"}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], ",", RowBox[{"AxesStyle", "\[Rule]", "Thick"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"2.75", " ", "72"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"embeddedPlane", "=", RowBox[{"Draw3D", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "0", "}"}], ",", RowBox[{"{", "0", "}"}]}], "}"}]}], ",", RowBox[{"MeshStyle", "\[Rule]", "Thick"}], ",", "\[IndentingNewLine]", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Legacy", "@", "AlizarinCrimson"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"inSpace", "=", RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.5", "]"}], ",", "\[IndentingNewLine]", "embeddedPlane", ",", "\[IndentingNewLine]", "Thick", ",", "Blue", ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"embed", "[", "a", "]"}], ",", RowBox[{"embed", "[", "b", "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"Point", "[", RowBox[{"embed", "[", "c", "]"}], "]"}], ",", "\[IndentingNewLine]", "Thick", ",", RowBox[{"Darker", "@", "Brown"}], ",", RowBox[{"Circle3D", "[", RowBox[{ RowBox[{"embed", "[", "ctr", "]"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}], ",", "r"}], "]"}]}], "\[IndentingNewLine]", "}"}], ",", RowBox[{"BoxRatios", "\[Rule]", "1"}], ",", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], ",", "\[IndentingNewLine]", "NiceRotation", ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"onComplexPlane", ",", ",", RowBox[{"Spacer", "[", "12", "]"}], ",", "inSpace"}], "}"}], "]"}]}], "Input", CellChangeTimes->{{3.496320437953125*^9, 3.4963204991875*^9}, { 3.4963205690625*^9, 3.496320897390625*^9}, {3.49632108596875*^9, 3.49632110659375*^9}, {3.496321147875*^9, 3.49632131303125*^9}, { 3.4963214171875*^9, 3.4963214604375*^9}, {3.496321491609375*^9, 3.49632164328125*^9}, {3.49632167415625*^9, 3.49632168028125*^9}, { 3.4963217381875*^9, 3.496321766890625*^9}, {3.49632180834375*^9, 3.49632198375*^9}, {3.49632202996875*^9, 3.496322135296875*^9}, { 3.496322255328125*^9, 3.496322314984375*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Stereographic projection", "Subsection", CellChangeTimes->{{3.494859208609375*^9, 3.494859214390625*^9}, 3.49632039003125*^9, 3.496321688359375*^9}], Cell[TextData[{ "The relationship between the extended complex plane ", Cell[BoxData[ FormBox[ RowBox[{" ", FormBox[ RowBox[{ StyleBox[" ", FontWeight->"Plain"], RowBox[{ StyleBox[ OverscriptBox["\[DoubleStruckCapitalC]", "^"], FontWeight->"Bold"], StyleBox["=", FontWeight->"Plain"], StyleBox[ RowBox[{"\[DoubleStruckCapitalC]", "\[Union]", RowBox[{"{", "\[Infinity]", "}"}]}], FontWeight->"Plain"]}]}], TraditionalForm]}], TraditionalForm]], FormatType->"TraditionalForm"], " and the Riemann sphere ", Cell[BoxData[ FormBox["\[CapitalOmega]", TraditionalForm]], FormatType->"TraditionalForm"], " is that they describe essentially the same \"space\" once you set up an \ appropriate one-to-one correspondence between the two." }], "Text", CellChangeTimes->{{3.49485894234375*^9, 3.494858948109375*^9}, { 3.494858988875*^9, 3.49485910896875*^9}, {3.49485992903125*^9, 3.494859932109375*^9}}], Cell[TextData[{ "That one-to-one correspondence is provided by the ", StyleBox["stereographic projection", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], " ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"p", ":", " ", "\[CapitalOmega]"}], "\[Rule]", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]]], " from the Riemann sphere onto the extended complex plane and its inverse ", Cell[BoxData[ FormBox[ RowBox[{"q", ":"}], TraditionalForm]], FormatType->"TraditionalForm"], Cell[BoxData[ FormBox[ RowBox[{" ", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]]], "\[Rule]\[ThinSpace]\[CapitalOmega], which in ", StyleBox["Presentations", FontSlant->"Italic"], " is called the ", StyleBox["stereographic map", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], "." }], "Text", CellChangeTimes->{{3.49485894234375*^9, 3.494858948109375*^9}, { 3.494858988875*^9, 3.494859135203125*^9}, {3.494859234171875*^9, 3.494859273796875*^9}, {3.4948598780625*^9, 3.494859924578125*^9}, { 3.494859968859375*^9, 3.49486002834375*^9}}], Cell[TextData[{ "The stereographic projection ", Cell[BoxData[ FormBox["p", TraditionalForm]], FormatType->"TraditionalForm"], " is defined as follows. If ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], "\[Element]", "\[CapitalOmega]"}], TraditionalForm]], FormatType->"TraditionalForm"], " is not the north pole ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], ", then ", Cell[BoxData[ FormBox[ RowBox[{"p", "(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " is the point at which the line in ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], " through ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " and the north pole intersects the embedded complex plane ", Cell[BoxData[ FormBox["\[DoubleStruckCapitalC]", TraditionalForm]], FormatType->"TraditionalForm"], "; and ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"p", "(", RowBox[{"north", " ", "pole"}], ")"}], "=", RowBox[{"\[Infinity]", "\[Element]", " ", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}]}], TraditionalForm]], FormatType->"TraditionalForm"], ", the point-at-infinity." }], "Text", CellChangeTimes->{{3.49485894234375*^9, 3.494858948109375*^9}, { 3.494858988875*^9, 3.494859135203125*^9}, {3.494859234171875*^9, 3.494859273796875*^9}, {3.4948598780625*^9, 3.494859924578125*^9}, { 3.494859968859375*^9, 3.494860075703125*^9}, {3.494860115359375*^9, 3.4948601235*^9}, {3.49486016084375*^9, 3.49486020459375*^9}, { 3.494861810453125*^9, 3.494861897953125*^9}, {3.49486436596875*^9, 3.494864433328125*^9}, {3.494866381671875*^9, 3.494866489453125*^9}}], Cell["\<\ Here is a static drawing to indicate how stereographic projection works.\ \>", "Text", CellChangeTimes->{{3.494866059953125*^9, 3.494866083703125*^9}, { 3.4961006088125*^9, 3.4961006158125*^9}, {3.49635014375*^9, 3.49635018146875*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"sphere", "=", RowBox[{"ColoredRiemannSphere", "[", RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"northPole", "=", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"embeddedPlane", "=", RowBox[{"Draw3D", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "0", "}"}], ",", RowBox[{"{", "0", "}"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Legacy", "@", "AlizarinCrimson"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ SubscriptBox["z", "0"], "=", RowBox[{ RowBox[{"3", "/", "2"}], "-", RowBox[{ RowBox[{"3", "/", "2"}], " ", "\[ImaginaryI]"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"complexPt", "=", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"ComplexPoint", "[", SubscriptBox["z", "0"], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"ptOnSphere", "=", RowBox[{"StereographicMap", "[", "complexPt", "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"projectedPt", "=", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"Point", "[", RowBox[{"embed", "[", SubscriptBox["z", "0"], "]"}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"projectionLine", "=", RowBox[{"{", RowBox[{"Thick", ",", "Black", ",", "Dashed", ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{"northPole", ",", RowBox[{"Last", "@", RowBox[{"Last", "@", "ptOnSphere"}]}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Dashing", "[", "None", "]"}], ",", RowBox[{"Arrow", "[", RowBox[{"{", RowBox[{ RowBox[{"Last", "@", RowBox[{"Last", "@", "ptOnSphere"}]}], ",", RowBox[{"Last", "@", RowBox[{"Last", "@", "projectedPt"}]}]}], "}"}], "]"}]}], "}"}]}], ";"}], "\n"}], "\[IndentingNewLine]", RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.5", "]"}], ",", "\[IndentingNewLine]", "embeddedPlane", ",", "\[IndentingNewLine]", "sphere", ",", "\[IndentingNewLine]", "ptOnSphere", ",", "\[IndentingNewLine]", "projectedPt", ",", "\[IndentingNewLine]", "projectionLine"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "Italic"}], "]"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1.5"}], ",", "1.5"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", "NiceRotation", ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"5", " ", "72"}]}]}], "\[IndentingNewLine]", "]"}]}], "Input", CellChangeTimes->{{3.496344633328125*^9, 3.496344697875*^9}, { 3.49634477315625*^9, 3.49634483534375*^9}, {3.496344865828125*^9, 3.496344890390625*^9}, {3.496344935453125*^9, 3.496345139015625*^9}, { 3.496351067125*^9, 3.4963510756875*^9}, {3.496351301734375*^9, 3.4963513041875*^9}, 3.496351433453125*^9}], Cell[TextData[{ "The stereographic map ", Cell[BoxData[ FormBox[ RowBox[{" ", RowBox[{ RowBox[{ FormBox[ RowBox[{"q", ":"}], TraditionalForm], FormBox[ RowBox[{" ", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]}], "\[Rule]", "\[CapitalOmega]"}]}], TraditionalForm]], FormatType->"TraditionalForm"], ", which is the inverse of stereographic projection ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"p", ":", " ", "\[CapitalOmega]"}], "\[Rule]", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]], FormatType->"TraditionalForm"], ", is therefore given as follows. If ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"x", "+", RowBox[{"\[ImaginaryI]", "\[ThinSpace]", "y"}]}], "=", RowBox[{ RowBox[{"(", RowBox[{"x", ",", "y"}], ")"}], "\[Element]", "\[DoubleStruckCapitalC]"}]}], TraditionalForm]], FormatType->"TraditionalForm"], ", then ", Cell[BoxData[ FormBox[ RowBox[{"q", "(", RowBox[{"x", "+", RowBox[{"\[ImaginaryI]", "\[ThinSpace]", "y"}]}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " is the point at which the line through ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"x", ",", "y", ",", "0"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " and the north pole intersects the Riemann sphere; and ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"q", "(", "\[Infinity]", ")"}], "=", RowBox[{"the", " ", "north", " ", "pole"}]}], TraditionalForm]], FormatType->"TraditionalForm"], "." }], "Text", CellChangeTimes->{{3.4948661266875*^9, 3.494866355890625*^9}}], Cell[TextData[{ "Here is a dynamic drawing of the stereographic map, where you can change \ the change the point ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", RowBox[{"x", "+", RowBox[{"\[ImaginaryI]", "\[ThinSpace]", "y"}]}]}], TraditionalForm]]], " in the complex plane that is mapped to the Riemann sphere." }], "Text", CellChangeTimes->{{3.494866093453125*^9, 3.494866107671875*^9}, { 3.494866513921875*^9, 3.49486656596875*^9}, {3.496350958296875*^9, 3.496350976421875*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"Clear", "[", RowBox[{ "complexPt", ",", "ptOnSphere", ",", "projectedPt", ",", "projectionLine"}], "]"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"sphere", "=", RowBox[{"ColoredRiemannSphere", "[", RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"northPole", "=", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"embeddedPlane", "=", RowBox[{"Draw3D", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "0", "}"}], ",", RowBox[{"{", "0", "}"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Legacy", "@", "AlizarinCrimson"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"complexPt", "[", "z_", "]"}], ":=", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"ComplexPoint", "[", "z", "]"}]}], "}"}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{"ptOnSphere", "[", "z_", "]"}], ":=", RowBox[{"StereographicMap", "[", RowBox[{"complexPt", "[", "z", "]"}], "]"}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"projectedPt", "[", "z_", "]"}], ":=", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"Point", "[", RowBox[{"embed", "[", "z", "]"}], "]"}]}], "}"}]}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"projectionLine", "[", "z_", "]"}], ":=", RowBox[{"{", RowBox[{"Thick", ",", "Black", ",", "Dashed", ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{"northPole", ",", RowBox[{"Last", "@", RowBox[{"Last", "@", RowBox[{"ptOnSphere", "[", "z", "]"}]}]}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Dashing", "[", "None", "]"}], ",", RowBox[{"Arrow", "[", RowBox[{"{", RowBox[{ RowBox[{"Last", "@", RowBox[{"Last", "@", RowBox[{"ptOnSphere", "[", "z", "]"}]}]}], ",", RowBox[{"Last", "@", RowBox[{"Last", "@", RowBox[{"projectedPt", "[", "z", "]"}]}]}]}], "}"}], "]"}]}], "}"}]}], "\[IndentingNewLine]"}], "\n", RowBox[{"Manipulate", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"z", "=", RowBox[{"ToComplex", "[", "pt", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Column", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", RowBox[{ RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "Italic"}], "]"}], ",", "\"\<\[ThinSpace]:\[ThinSpace]\>\"", ",", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "Italic"}], "]"}], ",", "\"\<\[ThinSpace]=\[ThinSpace]\>\"", ",", "z", ",", "\"\< \[Function] \>\"", ",", RowBox[{ RowBox[{ RowBox[{"NumberForm", "[", RowBox[{"#", ",", "4"}], "]"}], "&"}], "/@", RowBox[{"StereographicMap", "[", "pt", "]"}]}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.5", "]"}], ",", "\[IndentingNewLine]", "embeddedPlane", ",", "\[IndentingNewLine]", "sphere", ",", "\[IndentingNewLine]", RowBox[{"ptOnSphere", "[", "z", "]"}], ",", "\[IndentingNewLine]", RowBox[{"projectedPt", "[", "z", "]"}], ",", "\[IndentingNewLine]", RowBox[{"projectionLine", "[", "z", "]"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "Italic"}], "]"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1.5"}], ",", "1.5"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", "NiceRotation", ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"6", " ", "72"}]}]}], "\[IndentingNewLine]", "]"}], ","}], "\[IndentingNewLine]", "}"}], ",", RowBox[{"Alignment", "\[Rule]", "Center"}]}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"pt", ",", RowBox[{"{", RowBox[{"1.", ",", "1."}], "}"}], ",", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "Italic"}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "3."}], ",", RowBox[{"-", "3."}]}], "}"}], ",", RowBox[{"{", RowBox[{"3.", ",", "3."}], "}"}]}], "}"}]}], "\[IndentingNewLine]", "]"}]}], "Input", CellChangeTimes->{{3.496344633328125*^9, 3.496344697875*^9}, { 3.49634477315625*^9, 3.49634483534375*^9}, {3.496344865828125*^9, 3.496344890390625*^9}, {3.496344935453125*^9, 3.496345139015625*^9}, { 3.4963499725625*^9, 3.49634999628125*^9}, {3.49635002978125*^9, 3.496350078703125*^9}, {3.49635022109375*^9, 3.496350235859375*^9}, { 3.49635026646875*^9, 3.496350285515625*^9}, {3.496350320578125*^9, 3.49635050771875*^9}, {3.49635054765625*^9, 3.49635066075*^9}, { 3.49635069659375*^9, 3.496350846546875*^9}, 3.496351081890625*^9}], Cell[TextData[{ StyleBox["Exercise ", FontWeight->"Bold"], StyleBox[ CounterBox["Exercise"], FontWeight->"Bold"], StyleBox[".", FontWeight->"Bold"], " (a) Find an explicit formula for the image ", Cell[BoxData[ FormBox[ RowBox[{"p", "(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], TraditionalForm]]], " under stereographic projection of a point ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"x", ",", "y", ",", "z"}], ")"}], TraditionalForm]]], " other than the north pole on the Riemann sphere.\n(b) Find an explicit \ formula for the image ", Cell[BoxData[ FormBox[ RowBox[{"q", "(", RowBox[{"x", "+", RowBox[{"\[ImaginaryI]", "\[ThinSpace]", "y"}]}], ")"}], TraditionalForm]]], " under the stereographic map of a point ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"x", "+", RowBox[{"\[ImaginaryI]", "\[ThinSpace]", "y"}]}], "\[Element]", "\[DoubleStruckCapitalC]"}], TraditionalForm]]], ". Check your answer against what the ", StyleBox["Presentations", FontSlant->"Italic"], " function ", StyleBox["StereographicMap", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " gives." }], "Exercise", CellChangeTimes->{{3.49486858128125*^9, 3.494868811796875*^9}}, ParagraphSpacing->{0.5, 0}, CellTags->"formula"] }, Closed]], Cell[CellGroupData[{ Cell["Images of lines and circles under the stereographic map", "Subsection", CellChangeTimes->{{3.4963532750625*^9, 3.496353284859375*^9}}], Cell["\<\ What is the image of a line in the complex plane under the stereographic map? \ Here is an example, which of course can show only a bounded segment of such a \ line.\ \>", "Text", CellChangeTimes->{{3.4961003029375*^9, 3.49610033784375*^9}, { 3.496100987546875*^9, 3.49610102321875*^9}, {3.496352760265625*^9, 3.496352799234375*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"Clear", "[", RowBox[{ "z", ",", "complexPt", ",", "ptOnSphere", ",", "projectedPt", ",", "projectionLine", ",", "complexLine", ",", "projectedLine"}], "]"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"sphere", "=", RowBox[{"ColoredRiemannSphere", "[", RowBox[{"Lighter", "@", RowBox[{"HTML", "@", "DodgerBlue"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"northPole", "=", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"embeddedPlane", "=", RowBox[{"Draw3D", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "0", "}"}], ",", RowBox[{"{", "0", "}"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Legacy", "@", "AlizarinCrimson"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"a", "=", RowBox[{ RowBox[{"-", "2"}], "-", "\[ImaginaryI]"}]}], ";", RowBox[{"b", "=", RowBox[{"1", "-", RowBox[{"2", "\[ImaginaryI]"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"z", "[", "t_", "]"}], ":=", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "-", "t"}], ")"}], "a"}], "+", RowBox[{"t", " ", "b"}]}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"complexPt", "[", "t_", "]"}], ":=", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"ComplexPoint", "[", RowBox[{"z", "[", "t", "]"}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"ptOnSphere", "[", "t_", "]"}], ":=", RowBox[{ RowBox[{"complexPt", "[", "t", "]"}], "//", "StereographicMap"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"projectedPt", "[", "t_", "]"}], ":=", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", "Large", "]"}], ",", "Red", ",", RowBox[{"Point", "[", RowBox[{"embed", "[", RowBox[{"z", "[", "t", "]"}], "]"}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"projectionLine", "[", "t_", "]"}], ":=", RowBox[{"{", RowBox[{"Thick", ",", "Black", ",", "Dashed", ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{"northPole", ",", RowBox[{"Last", "@", RowBox[{"Last", "@", RowBox[{"ptOnSphere", "[", "t", "]"}]}]}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Dashing", "[", "None", "]"}], ",", RowBox[{"Arrow", "[", RowBox[{"{", RowBox[{ RowBox[{"Last", "@", RowBox[{"Last", "@", RowBox[{"ptOnSphere", "[", "t", "]"}]}]}], ",", RowBox[{"Last", "@", RowBox[{"Last", "@", RowBox[{"projectedPt", "[", "t", "]"}]}]}]}], "}"}], "]"}]}], "}"}]}], ";"}], "\n"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"complexLine", "[", "t_", "]"}], ":=", RowBox[{"{", RowBox[{"Thick", ",", "Red", ",", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"z", "[", "\[Tau]", "]"}], ",", RowBox[{"{", RowBox[{"\[Tau]", ",", "0", ",", "t"}], "}"}]}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"projectedLine", "[", "t_", "]"}], ":=", RowBox[{"{", RowBox[{"Thick", ",", "Red", ",", RowBox[{"ParametricDraw3D", "[", RowBox[{ RowBox[{"embed", "[", RowBox[{"z", "[", "\[Tau]", "]"}], "]"}], ",", RowBox[{"{", RowBox[{"\[Tau]", ",", "0", ",", "t"}], "}"}]}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{"Manipulate", "[", "\[IndentingNewLine]", "\n", RowBox[{ RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Opacity", "[", "0.5", "]"}], ",", "\[IndentingNewLine]", "embeddedPlane", ",", "\[IndentingNewLine]", "sphere", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"complexLine", "[", "t", "]"}], "//", "StereographicMap"}], ",", "\[IndentingNewLine]", RowBox[{"projectedLine", "[", "t", "]"}], ",", "\[IndentingNewLine]", RowBox[{"ptOnSphere", "[", "t", "]"}], ",", "\[IndentingNewLine]", RowBox[{"projectedPt", "[", "t", "]"}], ",", "\[IndentingNewLine]", RowBox[{"projectionLine", "[", "t", "]"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "->", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "Italic"}], "]"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1.5"}], ",", "1.5"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"5", " ", "72"}]}]}], "\[IndentingNewLine]", "]"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"t", ",", "0.01", ",", "10"}], "}"}]}], "\[IndentingNewLine]", "]"}]}], "Input", CellChangeTimes->{{3.496344633328125*^9, 3.496344697875*^9}, { 3.49634477315625*^9, 3.49634483534375*^9}, {3.496344865828125*^9, 3.496344890390625*^9}, {3.496344935453125*^9, 3.496345139015625*^9}, { 3.496351067125*^9, 3.4963510756875*^9}, {3.496351238296875*^9, 3.49635127490625*^9}, {3.496351374546875*^9, 3.496351388796875*^9}, 3.496351421609375*^9, {3.4963514786875*^9, 3.496351609328125*^9}, { 3.49635177140625*^9, 3.496351851734375*^9}, {3.496351907421875*^9, 3.49635229553125*^9}, {3.4963523301875*^9, 3.496352428890625*^9}, { 3.496352484375*^9, 3.496352525921875*^9}, {3.496352587296875*^9, 3.496352732765625*^9}}], Cell[TextData[{ StyleBox["Exercise ", FontWeight->"Bold"], StyleBox[ CounterBox["Exercise"], FontWeight->"Bold"], StyleBox[".", FontWeight->"Bold"], " (a) What seems to happen as ", Cell[BoxData[ FormBox[ RowBox[{"t", "\[Rule]", "\[Infinity]"}], TraditionalForm]], FormatType->"TraditionalForm"], " to the image, under the stereographic map, of the point ", Cell[BoxData[ FormBox[ RowBox[{"z", "(", "t", ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " on the parameterized line?\n(b) What does it look like the the image is of \ the entire line under the stereographic map?\n(c) Use the explicit formula \ you obtained in Exercise ", CounterBox["Exercise", "formula"], " to prove your conclusion in (b)." }], "Exercise", CellChangeTimes->{{3.49486858128125*^9, 3.494868811796875*^9}, { 3.496352815046875*^9, 3.496353012328125*^9}, {3.496353044859375*^9, 3.496353062890625*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ StyleBox["Exercise ", FontWeight->"Bold"], StyleBox[ CounterBox["Exercise"], FontWeight->"Bold"], StyleBox[".", FontWeight->"Bold"], " (a) Draw a circle in the complex plane and its image under the \ stereographic map.\n(b) What does that image seem to be?\n", StyleBox["(c)", FontFamily->"Times", FontWeight->"Plain", FontSlant->"Plain"], " Use the explicit formula you obtained in Exercise ", CounterBox["Exercise", "formula"], " to prove your conclusion in (b)." }], "Exercise", CellChangeTimes->{{3.49486858128125*^9, 3.494868811796875*^9}, { 3.496352815046875*^9, 3.496353012328125*^9}, {3.496353044859375*^9, 3.496353110515625*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ StyleBox["Exercise ", FontWeight->"Bold"], StyleBox[ CounterBox["Exercise"], FontWeight->"Bold"], StyleBox[".", FontWeight->"Bold"], " (a) Draw a circle on the Riemann sphere that does not pass through the \ north pole.\n(b) What does it look like the image of that circle is under the \ stereographic projection?\n", StyleBox["(c)", FontFamily->"Times", FontWeight->"Plain", FontSlant->"Plain"], " Use the explicit formula you obtained in Exercise ", CounterBox["Exercise", "formula"], " to prove your conclusion in (b)." }], "Exercise", CellChangeTimes->{{3.49486858128125*^9, 3.494868811796875*^9}, { 3.496352815046875*^9, 3.496353012328125*^9}, {3.496353044859375*^9, 3.496353062890625*^9}, {3.496353142234375*^9, 3.49635323846875*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ StyleBox["Exercise ", FontWeight->"Bold"], StyleBox[ CounterBox["Exercise"], FontWeight->"Bold"], StyleBox[".", FontWeight->"Bold"], " (a) Draw a circle on the Riemann sphere that passes through the north \ pole.\n(b) What does it look like the image of that circle is under the \ stereographic projection?\n", StyleBox["(c)", FontFamily->"Times", FontWeight->"Plain", FontSlant->"Plain"], " Use the explicit formula you obtained in Exercise ", CounterBox["Exercise", "formula"], " to prove your conclusion in (b)." }], "Exercise", CellChangeTimes->{{3.49486858128125*^9, 3.494868811796875*^9}, { 3.496352815046875*^9, 3.496353012328125*^9}, {3.496353044859375*^9, 3.496353062890625*^9}, {3.496353142234375*^9, 3.49635324590625*^9}}, ParagraphSpacing->{0.5, 0}] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Lifting geometric objects in the complex plane to the Riemann sphere\ \>", "Subsection", CellChangeTimes->{{3.494868511875*^9, 3.494868527203125*^9}}], Cell[TextData[{ "In the preceding section, we drew points and line segments on the complex \ plane embedded in ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], " and their images under the stereographic map. Thus the entire figure was \ one in 3-space ", Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm"], ". \nIn this section, by contrast, we construct \"two-panel\" figures \ consisting of a drawing of the complex plane and a separate drawing of the \ Riemann sphere. And we draw geometric objects directly in the complex plane ", Cell[BoxData[ FormBox["\[DoubleStruckCapitalC]", TraditionalForm]], FormatType->"TraditionalForm"], " and the corresponding objects on the Riemann sphere. " }], "Text", CellChangeTimes->{{3.496353367734375*^9, 3.496353590734375*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ "In the complex plane, form the set ", Cell[BoxData[ FormBox[ RowBox[{"A", "\[Subset]", "\[DoubleStruckCapitalC]"}], TraditionalForm]]], " that is the intersection of the closed disk ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox[ OverscriptBox["D", "_"], "2"], "(", "0", ")"}], TraditionalForm]]], " with the closed first quadrant (including the origin, the part along the \ positive real axis, and the part along the positive imaginary axis)." }], "Text", CellChangeTimes->{{3.4948685346875*^9, 3.494868535609375*^9}, { 3.49520344671875*^9, 3.495203459390625*^9}, {3.495212457125*^9, 3.495212483515625*^9}}], Cell[TextData[{ "First draw that set, highlighting the origin, the unit quarter-circle ", Cell[BoxData[ FormBox[ RowBox[{"|", "z", "|", RowBox[{"=", "1"}]}], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ RowBox[{"0", "\[LessEqual]", RowBox[{"Arg", "(", "z", ")"}], "\[LessEqual]", " ", FractionBox["\[Pi]", "2"]}], TraditionalForm]]], ", and the line segments ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"Re", "(", "z", ")"}], "=", "0"}], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"0", "\[LessEqual]"}], "|", "z", "|", RowBox[{"\[LessEqual]", "1"}]}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ RowBox[{"Im", "(", "z", ")"}], "=", "0"}], ",", RowBox[{ RowBox[{"0", "\[LessEqual]"}], "|", "z", "|", RowBox[{"\[LessEqual]", "1"}]}]}], TraditionalForm]]], "." }], "Text", CellChangeTimes->{{3.4948685346875*^9, 3.494868535609375*^9}, { 3.49520344671875*^9, 3.495203459390625*^9}, {3.495212457125*^9, 3.4952125589375*^9}, {3.495212612625*^9, 3.495212644078125*^9}, { 3.495212917125*^9, 3.49521293121875*^9}, 3.49635373325*^9}], Cell[BoxData[{ RowBox[{ RowBox[{"polargrid", "=", RowBox[{"DrawPolarMap", "[", RowBox[{"z", ",", RowBox[{"{", RowBox[{"z", ",", RowBox[{"ComplexPolar", "[", RowBox[{"0", ",", "0"}], "]"}], ",", RowBox[{"ComplexPolar", "[", RowBox[{"1", ",", RowBox[{"\[Pi]", "/", "2"}]}], "]"}]}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{"10", ",", "16"}], "}"}]}], ",", RowBox[{"MeshStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Directive", "[", RowBox[{"Thick", ",", RowBox[{"Darker", "@", RowBox[{"Legacy", "@", "Cobalt"}]}]}], "]"}], ",", RowBox[{"Directive", "[", RowBox[{"Thick", ",", RowBox[{"Legacy", "@", "IndianRed"}]}], "]"}]}], "}"}]}], ",", RowBox[{"BoundaryStyle", "\[Rule]", "None"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"setLabel", "=", RowBox[{"{", RowBox[{"Black", ",", RowBox[{"ComplexText", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{"\"\\"", ",", "30", ",", "Bold"}], "]"}], ",", RowBox[{"ComplexPolar", "[", RowBox[{"0.5", ",", RowBox[{"\[Pi]", "/", "3"}]}], "]"}]}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"origin", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"Darker", "@", "Blue"}], ",", RowBox[{"PointSize", "[", "Large", "]"}], ",", RowBox[{"ComplexPoint", "[", "0", "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxis", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"Legacy", "@", "CadmiumOrange"}], ",", "Thick", ",", RowBox[{"ComplexCurve", "[", RowBox[{"t", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"yAxis", "=", RowBox[{"{", RowBox[{"Blue", ",", "Thick", ",", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"t", " ", "\[ImaginaryI]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"quarterCircle", " ", "=", " ", RowBox[{"{", RowBox[{"Purple", ",", "Thick", ",", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"Exp", "[", RowBox[{"\[Theta]", " ", "I"}], "]"}], ",", RowBox[{"{", RowBox[{"\[Theta]", ",", "0", ",", RowBox[{"\[Pi]", "/", "2"}]}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"graphics2D", "=", RowBox[{"{", RowBox[{ "quarterCircle", ",", "xAxis", ",", "yAxis", ",", "origin", ",", "setLabel", ",", RowBox[{"Opacity", "[", RowBox[{"0.25", ",", RowBox[{"Lighter", "@", "Gray"}]}], "]"}], ",", "polargrid"}], "}"}]}], ";"}]}], "Input", CellChangeTimes->{{3.495185882515625*^9, 3.495185895109375*^9}, { 3.49518594728125*^9, 3.49518602390625*^9}, {3.495186060984375*^9, 3.4951861129393997`*^9}, {3.495186143288005*^9, 3.495186306126555*^9}, { 3.4951864116590624`*^9, 3.495186432834325*^9}, {3.49520323146875*^9, 3.49520341159375*^9}, {3.49520359678125*^9, 3.4952036575625*^9}, { 3.495203721296875*^9, 3.495203722296875*^9}, {3.4952096238125*^9, 3.4952097461875*^9}, {3.495209871515625*^9, 3.495209922984375*^9}, { 3.49521000971875*^9, 3.49521006690625*^9}, {3.49521024503125*^9, 3.495210283546875*^9}, {3.4952103715625*^9, 3.495210435328125*^9}, { 3.49521056953125*^9, 3.495210590703125*^9}, {3.495210711734375*^9, 3.49521081784375*^9}, 3.495211520671875*^9, {3.49521162778125*^9, 3.495211648015625*^9}, 3.495211688765625*^9, {3.495211751640625*^9, 3.495211752265625*^9}, {3.49521196340625*^9, 3.49521196865625*^9}, { 3.4952120168125*^9, 3.495212065921875*^9}, {3.495212140640625*^9, 3.495212182171875*^9}, {3.495212217484375*^9, 3.4952122366875*^9}, { 3.49521227925*^9, 3.49521228584375*^9}, {3.495212340671875*^9, 3.495212419359375*^9}, {3.495212688453125*^9, 3.495212784109375*^9}, { 3.49521282071875*^9, 3.49521289734375*^9}, {3.496094041140625*^9, 3.4960940468125*^9}, {3.49609426309375*^9, 3.49609426834375*^9}}], Cell[BoxData[ RowBox[{"in\[DoubleStruckCapitalC]", "=", RowBox[{"Draw2D", "[", RowBox[{ RowBox[{"{", "graphics2D", "}"}], ",", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesStyle", "\[Rule]", RowBox[{"Directive", "[", RowBox[{"Legacy", "@", "DimGray"}], "]"}]}], ",", RowBox[{"Ticks", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "1", "}"}], ",", RowBox[{"{", "1", "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.25"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.25"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"4", " ", "72"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.49518599959375*^9, 3.4951860066875*^9}, { 3.4951861236286097`*^9, 3.4951861294576674`*^9}, {3.495186200484655*^9, 3.495186202063032*^9}, {3.4951862321615973`*^9, 3.49518623345868*^9}, { 3.4951864371006327`*^9, 3.49518644086686*^9}, {3.495210829765625*^9, 3.495210864375*^9}, {3.49521105196875*^9, 3.495211057140625*^9}, { 3.495211090578125*^9, 3.495211092578125*^9}, 3.495211332171875*^9, { 3.495211499796875*^9, 3.49521151153125*^9}, 3.49521178003125*^9, { 3.495211887390625*^9, 3.495211899578125*^9}, {3.495212094609375*^9, 3.495212117046875*^9}, 3.495213008125*^9, {3.496093887375*^9, 3.496093890875*^9}}], Cell[TextData[{ "(For optimal results, you may need to specify a numerical ", StyleBox["Thickness", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " value, or a numerical ", StyleBox["PointSize", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], " value.)" }], "Text", CellChangeTimes->{{3.4948685346875*^9, 3.494868535609375*^9}, { 3.49520344671875*^9, 3.495203459390625*^9}, {3.495212457125*^9, 3.4952125589375*^9}, 3.495212612625*^9, {3.4952126648125*^9, 3.495212680234375*^9}, {3.49521294340625*^9, 3.495213004*^9}}], Cell[TextData[{ "Next, draw the corresponding set ", Cell[BoxData[ FormBox[ RowBox[{" ", FormBox[ RowBox[{ RowBox[{"q", "(", "A", ")"}], "=", RowBox[{ SuperscriptBox["p", RowBox[{"-", "1"}]], " ", RowBox[{"(", "A", ")"}]}]}], TraditionalForm]}], TraditionalForm]]], " on the Riemann sphere ", Cell[BoxData[ FormBox["\[CapitalOmega]", TraditionalForm]]], ":" }], "Text", CellChangeTimes->{{3.495212565890625*^9, 3.495212595875*^9}}], Cell[BoxData[ RowBox[{"on\[CapitalOmega]", "=", RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", RowBox[{ RowBox[{"Lighter", "@", RowBox[{"Legacy", "@", "SkyBlue"}]}], ",", "0.975"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"graphics2D", "//", "StereographicMap"}]}], "}"}], ",", "ViewRiemann", ",", "\[IndentingNewLine]", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"4", " ", "72"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.495186448149275*^9, 3.49518649625072*^9}, { 3.495203519125*^9, 3.495203541359375*^9}, {3.495209843671875*^9, 3.495209849296875*^9}, {3.495210475046875*^9, 3.49521053809375*^9}, { 3.495210618203125*^9, 3.495210660734375*^9}, 3.49521088365625*^9, { 3.495211061765625*^9, 3.495211070890625*^9}, {3.495211123234375*^9, 3.495211216765625*^9}, {3.495211266328125*^9, 3.495211273828125*^9}, 3.49521132203125*^9, {3.495211353671875*^9, 3.495211354359375*^9}, { 3.495211668*^9, 3.49521167859375*^9}, {3.49521171809375*^9, 3.4952117334375*^9}, {3.495211767234375*^9, 3.49521178409375*^9}, { 3.495211850953125*^9, 3.495211852859375*^9}, 3.49521303915625*^9, { 3.495213146828125*^9, 3.49521318434375*^9}}], Cell[TextData[{ "In the preceding Input cell, notice the use of the second argument, ", StyleBox["0.975", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ", in ", StyleBox["ColoredRiemannSphere", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ". This shrinks the sphere a bit more from its default radius 0.995 so as to \ make the highlighted objects stand out better against the sphere." }], "Text", CellChangeTimes->{{3.495213051671875*^9, 3.49521312740625*^9}, { 3.495213197859375*^9, 3.495213210953125*^9}}], Cell[TextData[{ "Finally, display in a \"two-panel plot\" both the original set ", Cell[BoxData[ FormBox["A", TraditionalForm]], FormatType->"TraditionalForm"], " in the complex plane and its image ", Cell[BoxData[ FormBox[ RowBox[{"q", "(", "A", ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " on the Riemann sphere." }], "Text", CellChangeTimes->{{3.495213228453125*^9, 3.49521327471875*^9}}], Cell[BoxData[ RowBox[{"Row", "[", RowBox[{"{", RowBox[{"in\[DoubleStruckCapitalC]", ",", RowBox[{"Spacer", "[", "5", "]"}], ",", "on\[CapitalOmega]"}], "}"}], "]"}]], "Input", CellChangeTimes->{{3.495211041203125*^9, 3.495211044265625*^9}, { 3.495211075578125*^9, 3.49521108525*^9}, 3.4952111175*^9, { 3.495213286046875*^9, 3.495213290546875*^9}}], Cell[TextData[{ "In the following figure, a control allows you to interactively rotate the \ Riemann sphere and with it the objects mapped from the complex plane onto it. \ The rotation is accomplished by the ", StyleBox["Presentations", FontSlant->"Italic"], " function ", StyleBox["RotationTransformOp", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], ", which rotates by the angle given as its first argument around the vector ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm"], " form the origin to the north pole. (This example is a simplified version \ of an example that appears in Eisenberg and Park [", ButtonBox["1", BaseStyle->"Hyperlink", ButtonData->"MeAndParkTMJ11#2"], "]; that one is, in turn, based upon an example from an earlier version of \ this notebook.)" }], "Text", CellChangeTimes->{{3.4960942293125*^9, 3.496094252046875*^9}, { 3.49609429171875*^9, 3.49609465371875*^9}}], Cell[BoxData[ RowBox[{"Manipulate", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", "\[IndentingNewLine]", RowBox[{"in\[DoubleStruckCapitalC]", ",", "\[IndentingNewLine]", RowBox[{"Draw3DItems", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", RowBox[{ RowBox[{"Lighter", "@", RowBox[{"Legacy", "@", "SkyBlue"}]}], ",", "0.975"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"graphics2D", "//", "StereographicMap"}]}], "}"}], "//", RowBox[{"RotationTransformOp", "[", RowBox[{"\[Alpha]", ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], "]"}]}], ",", "\[IndentingNewLine]", "ViewRiemann", ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"Scaled", "[", "0.35", "]"}]}]}], "\[IndentingNewLine]", "]"}]}], "\[IndentingNewLine]", "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"\[Alpha]", ",", "0", ",", "\"\\""}], "}"}], ",", "0", ",", RowBox[{"2", "\[Pi]"}]}], "}"}]}], "\[IndentingNewLine]", "]"}]], "Input", CellChangeTimes->{{3.496093928359375*^9, 3.496093932125*^9}, { 3.496093977671875*^9, 3.496094013421875*^9}, {3.49609408584375*^9, 3.4960941*^9}, {3.496094156203125*^9, 3.496094213328125*^9}, { 3.496094278328125*^9, 3.4960942843125*^9}, {3.496094661359375*^9, 3.49609468121875*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Representing a function ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", ":", "\[DoubleStruckCapitalC]"}], "\[Rule]", "\[DoubleStruckCapitalC]"}], TraditionalForm]]], " as a corresponding mapping ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ OverscriptBox["f", "^"], ":", "\[CapitalOmega]"}], "\[Rule]", "\[CapitalOmega]"}], TraditionalForm]]], " of the Riemann sphere" }], "Section", CellChangeTimes->{{3.496094710234375*^9, 3.496094723171875*^9}}], Cell[CellGroupData[{ Cell["Example 1: the squaring function", "Subsection"], Cell[TextData[{ "The function ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", ":", "\[DoubleStruckCapitalC]"}], "\[Rule]", "\[DoubleStruckCapitalC]"}], TraditionalForm]]], " will be the squaring function:" }], "Text", CellChangeTimes->{{3.49609473003125*^9, 3.4960947336875*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{"f", ",", "z"}], "]"}]], "Input", CellChangeTimes->{{3.496354128859375*^9, 3.4963541311875*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "z_", "]"}], ":=", SuperscriptBox["z", "2"]}]], "Input", CellChangeTimes->{{3.49609473640625*^9, 3.49609473784375*^9}}], Cell[CellGroupData[{ Cell[TextData[{ "Visualize ", Cell[BoxData[ FormBox["f", TraditionalForm]]], " as a mapping of the complex plane" }], "Subsubsection"], Cell[TextData[{ "In the complex plane, form the set ", Cell[BoxData[ FormBox[ RowBox[{"A", "\[Subset]", "\[DoubleStruckCapitalC]"}], TraditionalForm]]], " that is the intersection of the unit closed disk ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox[ OverscriptBox["D", "_"], "1"], "(", "0", ")"}], TraditionalForm]]], " with the closed first quadrant (including the origin, the part along the \ positive real axis, and the part along the positive imaginary axis)." }], "Text", CellChangeTimes->{{3.496355412828125*^9, 3.49635543278125*^9}}], Cell[TextData[{ "To visualize ", Cell[BoxData[ FormBox["f", TraditionalForm]]], " as a transformation of the complex plane, construct a \"two-panel plot\" \ consisting of drawings of both ", Cell[BoxData[ FormBox["A", TraditionalForm]]], " and its image ", Cell[BoxData[ FormBox[ RowBox[{"f", "(", "A", ")"}], TraditionalForm]]], ", as in notebook ", StyleBox["VisualizingFunctions.nb", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], "." }], "Text", CellChangeTimes->{{3.496354508859375*^9, 3.496354557328125*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"polargrid", "=", RowBox[{"DrawPolarMap", "[", RowBox[{"z", ",", RowBox[{"{", RowBox[{"z", ",", RowBox[{"ComplexPolar", "[", RowBox[{"0", ",", "0"}], "]"}], ",", RowBox[{"ComplexPolar", "[", RowBox[{"1", ",", RowBox[{"\[Pi]", "/", "2"}]}], "]"}]}], "}"}], ",", RowBox[{"Mesh", "\[Rule]", RowBox[{"{", RowBox[{"10", ",", "16"}], "}"}]}], ",", RowBox[{"MeshStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Directive", "[", RowBox[{"Thick", ",", RowBox[{"Darker", "@", RowBox[{"Legacy", "@", "Cobalt"}]}]}], "]"}], ",", RowBox[{"Directive", "[", RowBox[{"Thick", ",", RowBox[{"Legacy", "@", "IndianRed"}]}], "]"}]}], "}"}]}], ",", RowBox[{"BoundaryStyle", "\[Rule]", "None"}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"origin", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"Darker", "@", "Blue"}], ",", RowBox[{"PointSize", "[", "Large", "]"}], ",", RowBox[{"ComplexPoint", "[", "0", "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxis", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"Legacy", "@", "CadmiumOrange"}], ",", "Thick", ",", RowBox[{"ComplexCurve", "[", RowBox[{"t", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"yAxis", "=", RowBox[{"{", RowBox[{"Blue", ",", "Thick", ",", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"t", " ", "\[ImaginaryI]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"quarterCircle", " ", "=", " ", RowBox[{"{", RowBox[{"Purple", ",", "Thick", ",", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"Exp", "[", RowBox[{"\[Theta]", " ", "I"}], "]"}], ",", RowBox[{"{", RowBox[{"\[Theta]", ",", "0", ",", RowBox[{"\[Pi]", "/", "2"}]}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"graphics2D", "=", RowBox[{"{", RowBox[{"quarterCircle", ",", "xAxis", ",", "yAxis", ",", "origin", ",", RowBox[{"Opacity", "[", RowBox[{"0.25", ",", RowBox[{"Lighter", "@", "Gray"}]}], "]"}], ",", "polargrid"}], "}"}]}], ";"}], "\n"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"domain", "=", RowBox[{"Draw2D", "[", RowBox[{ RowBox[{"{", "graphics2D", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesStyle", "\[Rule]", RowBox[{"Directive", "[", RowBox[{"Legacy", "@", "DimGray"}], "]"}]}], ",", RowBox[{"Ticks", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "1", "}"}], ",", RowBox[{"{", "1", "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"image", "=", RowBox[{"Draw2D", "[", RowBox[{ RowBox[{"{", RowBox[{"graphics2D", "//", RowBox[{"ComplexMap", "[", "f", "]"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesStyle", "\[Rule]", RowBox[{"Directive", "[", RowBox[{"Legacy", "@", "DimGray"}], "]"}]}], ",", RowBox[{"Ticks", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "1", "}"}], ",", RowBox[{"{", "1", "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1"}], "}"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"domain", ",", RowBox[{"Spacer", "[", "30", "]"}], ",", "image"}], "}"}], "]"}]}], "Input", CellChangeTimes->{{3.495185882515625*^9, 3.495185895109375*^9}, { 3.49518594728125*^9, 3.49518602390625*^9}, {3.495186060984375*^9, 3.4951861129393997`*^9}, {3.495186143288005*^9, 3.495186306126555*^9}, { 3.4951864116590624`*^9, 3.495186432834325*^9}, {3.49520323146875*^9, 3.49520341159375*^9}, {3.49520359678125*^9, 3.4952036575625*^9}, { 3.495203721296875*^9, 3.495203722296875*^9}, {3.4952096238125*^9, 3.4952097461875*^9}, {3.495209871515625*^9, 3.495209922984375*^9}, { 3.49521000971875*^9, 3.49521006690625*^9}, {3.49521024503125*^9, 3.495210283546875*^9}, {3.4952103715625*^9, 3.495210435328125*^9}, { 3.49521056953125*^9, 3.495210590703125*^9}, {3.495210711734375*^9, 3.49521081784375*^9}, 3.495211520671875*^9, {3.49521162778125*^9, 3.495211648015625*^9}, 3.495211688765625*^9, {3.495211751640625*^9, 3.495211752265625*^9}, {3.49521196340625*^9, 3.49521196865625*^9}, { 3.4952120168125*^9, 3.495212065921875*^9}, {3.495212140640625*^9, 3.495212182171875*^9}, {3.495212217484375*^9, 3.4952122366875*^9}, { 3.49521227925*^9, 3.49521228584375*^9}, {3.495212340671875*^9, 3.495212419359375*^9}, {3.495212688453125*^9, 3.495212784109375*^9}, { 3.49521282071875*^9, 3.49521289734375*^9}, {3.496094041140625*^9, 3.4960940468125*^9}, {3.49609426309375*^9, 3.49609426834375*^9}, { 3.496353781328125*^9, 3.496353792796875*^9}, {3.496353835421875*^9, 3.496353883046875*^9}, 3.496353925078125*^9, {3.496354020703125*^9, 3.49635403865625*^9}, {3.496354083296875*^9, 3.496354103046875*^9}, { 3.4963541698125*^9, 3.496354206328125*^9}, {3.496354238796875*^9, 3.496354301875*^9}, {3.49635463353125*^9, 3.496354734515625*^9}, { 3.496355324515625*^9, 3.496355366953125*^9}, {3.496355454078125*^9, 3.49635553971875*^9}}] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Visualize ", Cell[BoxData[ FormBox["f", TraditionalForm]]], " as a mapping of the Riemann sphere" }], "Subsubsection"], Cell[TextData[{ "Now \"lift\" both the set ", Cell[BoxData[ FormBox[ RowBox[{"A", " ", "\[Subset]", " ", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]]], " in the extended plane and its image ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", "(", "A", ")"}], " ", "\[Subset]", " ", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]]], " in the extended plane to the corresponding sets ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["p", RowBox[{"-", "1"}]], "(", "A", ")"}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["p", RowBox[{"-", "1"}]], "(", RowBox[{"f", "(", "A", ")"}], ")"}], TraditionalForm]]], " in the Riemann sphere. This allows us to visualize the function ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ OverscriptBox["f", "^"], " ", ":", " ", "\[CapitalOmega]"}], " ", "\[Rule]", " ", "\[CapitalOmega]"}], TraditionalForm]]], " instead as a corresponding transformation ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"F", " ", ":", " ", "\[CapitalOmega]"}], " ", "\[Rule]", " ", "\[CapitalOmega]"}], TraditionalForm]]], " of the Riemann sphere." }], "Text"], Cell["\<\ Next, use the stereographic map to lift the geometric objects in the domain \ to one copy of the Riemann sphere and the images of those objects to another \ copy of the Riemann sphere.\ \>", "Text", CellChangeTimes->{{3.496354315140625*^9, 3.49635436040625*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"domainOn\[CapitalOmega]", "=", RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", RowBox[{ RowBox[{"Lighter", "@", RowBox[{"Legacy", "@", "SkyBlue"}]}], ",", "0.975"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"graphics2D", "//", "StereographicMap"}]}], "}"}], ",", "\[IndentingNewLine]", "ViewRiemann", ",", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"imageOn\[CapitalOmega]", "=", RowBox[{"Draw3DItems", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", RowBox[{ RowBox[{"Lighter", "@", RowBox[{"Legacy", "@", "SkyBlue"}]}], ",", "0.975"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"graphics2D", "//", RowBox[{"ComplexMap", "[", "f", "]"}]}], "//", "StereographicMap"}]}], "}"}], ",", "\[IndentingNewLine]", "ViewRiemann", ",", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"domainOn\[CapitalOmega]", ",", RowBox[{"Spacer", "[", "5", "]"}], ",", "imageOn\[CapitalOmega]"}], "}"}], "]"}]}], "Input", CellChangeTimes->{{3.495185882515625*^9, 3.495185895109375*^9}, { 3.49518594728125*^9, 3.49518602390625*^9}, {3.495186060984375*^9, 3.4951861129393997`*^9}, {3.495186143288005*^9, 3.495186306126555*^9}, { 3.4951864116590624`*^9, 3.495186432834325*^9}, {3.49520323146875*^9, 3.49520341159375*^9}, {3.49520359678125*^9, 3.4952036575625*^9}, { 3.495203721296875*^9, 3.495203722296875*^9}, {3.4952096238125*^9, 3.4952097461875*^9}, {3.495209871515625*^9, 3.495209922984375*^9}, { 3.49521000971875*^9, 3.49521006690625*^9}, {3.49521024503125*^9, 3.495210283546875*^9}, {3.4952103715625*^9, 3.495210435328125*^9}, { 3.49521056953125*^9, 3.495210590703125*^9}, {3.495210711734375*^9, 3.49521081784375*^9}, 3.495211520671875*^9, {3.49521162778125*^9, 3.495211648015625*^9}, 3.495211688765625*^9, {3.495211751640625*^9, 3.495211752265625*^9}, {3.49521196340625*^9, 3.49521196865625*^9}, { 3.4952120168125*^9, 3.495212065921875*^9}, {3.495212140640625*^9, 3.495212182171875*^9}, {3.495212217484375*^9, 3.4952122366875*^9}, { 3.49521227925*^9, 3.49521228584375*^9}, {3.495212340671875*^9, 3.495212419359375*^9}, {3.495212688453125*^9, 3.495212784109375*^9}, { 3.49521282071875*^9, 3.49521289734375*^9}, {3.496094041140625*^9, 3.4960940468125*^9}, {3.49609426309375*^9, 3.49609426834375*^9}, { 3.496353781328125*^9, 3.496353792796875*^9}, {3.496354374359375*^9, 3.49635447021875*^9}, {3.49635474378125*^9, 3.496354746*^9}, { 3.496355583328125*^9, 3.4963556046875*^9}, {3.496355669796875*^9, 3.4963556744375*^9}}], Cell["\<\ The next figure shows the domain and its image in the complex plane along \ with the corresponding sets on the Riemann sphere.\ \>", "Text", CellChangeTimes->{{3.496354788390625*^9, 3.4963548345*^9}}], Cell[BoxData[ RowBox[{"Grid", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"domain", ",", RowBox[{"Spacer", "[", "2", "]"}], ",", RowBox[{"Column", "[", RowBox[{"{", RowBox[{ RowBox[{"TraditionalForm", "[", "f", "]"}], ",", "\"\<\[LongRightArrow]\>\""}], "}"}], "]"}], ",", RowBox[{"Spacer", "[", "2", "]"}], ",", "image"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", RowBox[{ RowBox[{"TraditionalForm", "[", "p", "]"}], ",", "\"\< \[UpArrow]\>\""}], "}"}], "]"}], ",", ",", RowBox[{"Spacer", "[", "5", "]"}], ",", ",", RowBox[{"Row", "[", RowBox[{"{", RowBox[{ RowBox[{"TraditionalForm", "[", "p", "]"}], ",", "\"\< \[DownArrow]\>\""}], "}"}], "]"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"domainOn\[CapitalOmega]", ",", RowBox[{"Spacer", "[", "2", "]"}], ",", RowBox[{"Column", "[", RowBox[{"{", RowBox[{ RowBox[{"TraditionalForm", "[", "F", "]"}], ",", "\"\<\[LongRightArrow]\>\""}], "}"}], "]"}], ",", RowBox[{"Spacer", "[", "2", "]"}], ",", "imageOn\[CapitalOmega]"}], "}"}]}], "}"}], "]"}]], "Input", CellChangeTimes->{{3.49635484225*^9, 3.4963550704375*^9}, { 3.49635510540625*^9, 3.496355106796875*^9}, {3.49635518065625*^9, 3.49635519775*^9}, {3.496355747078125*^9, 3.496355760203125*^9}, { 3.496355797375*^9, 3.49635581659375*^9}, {3.49635639225*^9, 3.4963566065625*^9}, {3.496356645375*^9, 3.496356699921875*^9}}], Cell[TextData[{ "Since ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SubscriptBox["lim", RowBox[{"z", "\[Rule]", "\[Infinity]"}]], RowBox[{"f", "(", "z", ")"}]}], "=", "\[Infinity]"}], TraditionalForm]], FormatType->"TraditionalForm"], ", the squaring function ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", ":", "\[DoubleStruckCapitalC]"}], "\[Rule]", "\[DoubleStruckCapitalC]"}], TraditionalForm]], FormatType->"TraditionalForm"], " has the \"natural\" extension\n\t", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ OverscriptBox["f", "^"], ":", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], "\[Rule]", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], TraditionalForm]], FormatType->"TraditionalForm"], "\ndefined by\n\t", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", "(", "z", ")"}], "=", RowBox[{"{", GridBox[{ { RowBox[{"f", "(", "z", ")"}], "if", RowBox[{ RowBox[{"z", "\[Element]", "\[DoubleStruckCapitalC]"}], ","}]}, {"\[Infinity]", "if", RowBox[{"z", "=", RowBox[{"\[Infinity]", "."}]}]} }]}]}], TraditionalForm]], FormatType->"TraditionalForm"], "\nThe function\n\t", Cell[BoxData[ FormBox[ RowBox[{"F", "=", RowBox[{ RowBox[{"q", " ", "\[EmptySmallCircle]", " ", OverscriptBox["f", "^"], " ", "\[EmptySmallCircle]", " ", "p"}], "=", " ", RowBox[{ RowBox[{ SuperscriptBox["p", RowBox[{"-", "1"}]], " ", "\[EmptySmallCircle]", " ", OverscriptBox["f", "^"], " ", "\[EmptySmallCircle]", " ", RowBox[{"p", ":", "\[CapitalOmega]"}]}], "\[Rule]", "\[CapitalOmega]"}]}]}], TraditionalForm]], FormatType->"TraditionalForm"], "\nis the", StyleBox[" lift ", FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]], "of ", Cell[BoxData[ FormBox["f", TraditionalForm]], FormatType->"TraditionalForm"], " to the Riemann sphere. " }], "Text", CellChangeTimes->{{3.49635583678125*^9, 3.49635591209375*^9}, { 3.49635596034375*^9, 3.496356307171875*^9}}, ParagraphSpacing->{0.5, 0}], Cell[TextData[{ "It's only \"behind the scenes\" here that the ", StyleBox["Mathematica", FontSlant->"Italic"], " function ", StyleBox["StereographicMap", FontFamily->"Courier"], " realizes the function ", Cell[BoxData[ FormBox[ RowBox[{"q", "=", RowBox[{ RowBox[{ SuperscriptBox["p", RowBox[{"-", "1"}]], " ", ":", " ", OverscriptBox["\[DoubleStruckCapitalC]", "^"]}], " ", "\[Rule]", " ", "\[CapitalOmega]"}]}], TraditionalForm]]], "." }], "Text", CellChangeTimes->{{3.496355647453125*^9, 3.49635564796875*^9}}], Cell[TextData[{ "XXX The rest of this notebook has not yet been migrated to the current \ version of ", StyleBox["Presentations", FontSlant->"Italic"], "!" }], "PinkComments", CellChangeTimes->{{3.496094771078125*^9, 3.496094785625*^9}}], Cell["\<\ Here are the same set in the Riemann sphere and its image, but now both \ viewed with the two copies of the Riemann sphere rotating synchronously:\ \>", "Text", CellOpen->False], Cell[BoxData[{ RowBox[{ RowBox[{"grid", "=", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", "RoyalBlue", "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", "1", ",", "10"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", RowBox[{"\[Pi]", "/", "2"}], ",", "16"}], "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", "IndianRed", "}"}], ",", " ", RowBox[{"{", RowBox[{"1", ",", "2.", ",", "10"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", RowBox[{"\[Pi]", "/", "2"}], ",", "16"}], "}"}]}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"gridmap", "=", RowBox[{ RowBox[{"First", "[", RowBox[{"PolarGrid", "[", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "8"}], "}"}], ",", RowBox[{"{", "grid", "}"}]}], "]"}], "]"}], "//", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", "8"}], "]"}]}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxis", " ", "=", " ", RowBox[{"{", RowBox[{"CadmiumLemon", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{ RowBox[{"ComplexLine", "[", RowBox[{"{", RowBox[{"0", ",", " ", "2"}], "}"}], "]"}], " ", "//", " ", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", " ", "8"}], "]"}]}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"quarterCircle", " ", "=", " ", RowBox[{"{", RowBox[{"Purple", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"Exp", "[", RowBox[{"\[Theta]", " ", "I"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"\[Theta]", ",", " ", "0", ",", " ", RowBox[{"\[Pi]", "/", "2"}]}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"TwoPanelAnimation", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", "\[IndentingNewLine]", "RiemannSphere", ",", " ", "rotation", ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", "]"}], ",", RowBox[{"{", RowBox[{"gridmap", ",", " ", "xAxis", ",", " ", "quarterCircle"}], "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"PlotRegion", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}]}], "}"}]}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}]}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"f", "[", "#", "]"}], "&"}], "}"}], ",", "\[IndentingNewLine]", "RiemannSphere", ",", " ", "rotation", ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", "]"}], ",", RowBox[{"{", RowBox[{"gridmap", ",", " ", "xAxis", ",", " ", "quarterCircle"}], "}"}]}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"PlotRegion", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}]}], "}"}]}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}]}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"12", "*", "72"}]}]}], "]"}], "[", "18", "]"}], ";"}]}], "Input", CellOpen->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Example 2: the reciprocal function", "Subsection"], Cell["Consider now the example:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "z_", "]"}], " ", ":=", " ", FractionBox["1", "z"]}]], "Input"], Cell[TextData[{ "Because ", Cell[BoxData[ FormBox[ RowBox[{"f", "(", "z", ")"}], TraditionalForm]]], " becomes very large in modulus as ", Cell[BoxData[ FormBox["z", TraditionalForm]]], " approaches 0, in this example the grid needs to be kept away from the \ origin. To highlight the inversion, the segment of the ", Cell[BoxData[ FormBox["x", TraditionalForm]]], "-axis is colored with two different colors\[LongDash]one inside the unit \ circle and the other outside the unit circle." }], "Text"], Cell[CellGroupData[{ Cell[TextData[{ "Visualize ", Cell[BoxData[ FormBox["f", TraditionalForm]]], " as a mapping of the complex plane" }], "Subsubsection"], Cell[BoxData[{ RowBox[{ RowBox[{"grid", "=", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", "RoyalBlue", "}"}], ",", " ", RowBox[{"{", RowBox[{"0.5", ",", "1", ",", "10"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", RowBox[{"\[Pi]", "/", "2"}], ",", "16"}], "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", "IndianRed", "}"}], ",", " ", RowBox[{"{", RowBox[{"1", ",", "2.", ",", "10"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", RowBox[{"\[Pi]", "/", "2"}], ",", "16"}], "}"}]}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"gridmap", "=", RowBox[{ RowBox[{"First", "[", RowBox[{"PolarGrid", "[", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "8"}], "}"}], ",", RowBox[{"{", "grid", "}"}]}], "]"}], "]"}], "//", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", "8"}], "]"}]}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxisInside", " ", "=", " ", RowBox[{"{", RowBox[{"CadmiumLemon", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{ RowBox[{"ComplexLine", "[", RowBox[{"{", RowBox[{"0.5", ",", " ", "1"}], "}"}], "]"}], " ", "//", " ", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", " ", "8"}], "]"}]}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxisOutside", " ", "=", " ", RowBox[{"{", RowBox[{"MediumSeaGreen", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{ RowBox[{"ComplexLine", "[", RowBox[{"{", RowBox[{"1.", ",", " ", "2."}], "}"}], "]"}], " ", "//", " ", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", " ", "8"}], "]"}]}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"quarterCircle", " ", "=", " ", RowBox[{"{", RowBox[{"Purple", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"Exp", "[", RowBox[{"\[Theta]", " ", "I"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"\[Theta]", ",", " ", "0", ",", " ", RowBox[{"\[Pi]", "/", "2"}]}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}]}], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"TwoPanelPlot", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", " ", "PolarGrid", ",", " ", RowBox[{"{", RowBox[{"0", ",", " ", "2.5"}], "}"}], ",", " ", RowBox[{"{", "grid", "}"}], ",", " ", RowBox[{"{", RowBox[{ "xAxisInside", ",", " ", "xAxisOutside", ",", " ", "quarterCircle"}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"f", "[", "#", "]"}], "&"}], "}"}], ",", " ", "PolarGrid", ",", " ", RowBox[{"{", RowBox[{"0", ",", " ", "2.5", ",", " ", "False"}], "}"}], ",", " ", RowBox[{"{", "grid", "}"}], ",", " ", RowBox[{"{", RowBox[{ "xAxisInside", ",", " ", "xAxisOutside", ",", " ", "quarterCircle"}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"12", "*", "72"}]}]}], "]"}], ";"}]], "Input"], Cell[TextData[{ StyleBox["\[WarningSign]", FontWeight->"Bold", Magnification->2, FontColor->RGBColor[1, 0, 0], Background->RGBColor[1, 1, 0]], " ", StyleBox["Caution:", FontWeight->"Bold", FontSlant->"Italic", FontVariations->{"Underline"->True}], " In the second argument to ", StyleBox["TwoPanelPlot", FontFamily->"Courier"], "\[LongDash]the argument that draws the image under the function ", StyleBox["f", FontFamily->"Courier"], "\[LongDash]the third entry ", StyleBox["False", FontFamily->"Courier"], " in the list ", StyleBox["{0, 2.5, False}", FontFamily->"Courier"], " is required to prevent ", StyleBox["f[z]", FontFamily->"Courier"], " from being evaluated at", StyleBox[" ", FontFamily->"Times"], StyleBox["z = 0", FontFamily->"Courier"], ". After all, ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"f", "(", "0", ")"}], " ", "=", " ", "\[Infinity]"}], TraditionalForm]]], ", which is not a complex number! (It wouldn't hurt to include such an \ entry in the first argument, either.)" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Visualize ", Cell[BoxData[ FormBox["f", TraditionalForm]]], " as a mapping of the Riemann sphere" }], "Subsubsection"], Cell[TextData[{ "The input cell below uses the definitions of grid, etc., that were just \ used for the ", StyleBox["TwoPanelPlot", FontFamily->"Courier"], " in the complex plane." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"TwoPanelPlot", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", "\[IndentingNewLine]", "RiemannSphere", ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", "]"}], ",", " ", RowBox[{"{", RowBox[{ "gridmap", ",", " ", "xAxisInside", ",", " ", "xAxisOutside", ",", " ", "quarterCircle"}], "}"}]}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"PlotRegion", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}]}], "}"}]}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}]}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"f", "[", "#", "]"}], "&"}], "}"}], ",", "\[IndentingNewLine]", "RiemannSphere", ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", "]"}], ",", " ", RowBox[{"{", RowBox[{ "gridmap", ",", " ", "xAxisInside", ",", " ", "xAxisOutside", ",", " ", "quarterCircle"}], "}"}]}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"PlotRegion", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}]}], "}"}]}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}]}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"12", "*", "72"}]}]}], "]"}], ";"}]], "Input"], Cell[TextData[{ StyleBox["\[WarningSign]", FontWeight->"Bold", Magnification->2, FontColor->RGBColor[1, 0, 0], Background->RGBColor[1, 1, 0]], " ", StyleBox["Caution:", FontWeight->"Bold", FontSlant->"Italic", FontVariations->{"Underline"->True}], " For the right-hand panel above, you would ", StyleBox["not", FontSlant->"Italic", FontVariations->{"Underline"->True}], " obtain the same result with:\n", StyleBox["\t{\n \t {f[#]&},\n \t RiemannSphere,\n \t {0,1.1},\n \t \ {ColoredRiemannSphere[], {gridmap}}, \n \t {{{xAxisInside, xAxisOutside, \ quarterCircle} // StereographicMap}},\n\t {", FontFamily->"Courier"], StyleBox["PlotRegion\[Rule]{{-0.25,1.1},{-0.25,1.1}}, ", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], StyleBox["ViewPoint\[Rule] {2.486, 1.127, 1.5}}\n\t}", FontFamily->"Courier"], "\n In this ", StyleBox["wrong", FontSlant->"Italic", FontVariations->{"Underline"->True}], " version, where ", StyleBox["{xAxisInside, xAxisOutside, quarterCircle} // StereographicMap", FontFamily->"Courier"], " is in the \"extra primitives\" part, the function ", StyleBox["f", FontFamily->"Courier"], " does not get applied to the sets; those sets merely get lifted directly to \ the Riemann sphere, without being acted upon by f." }], "Text"], Cell["\<\ Here are the same set in the Riemann sphere and its image, but now both \ viewed with the two copies of the Riemann sphere rotating synchronously:\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"grid", "=", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", "RoyalBlue", "}"}], ",", " ", RowBox[{"{", RowBox[{"0.5", ",", "1", ",", "10"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", RowBox[{"\[Pi]", "/", "2"}], ",", "16"}], "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", "IndianRed", "}"}], ",", " ", RowBox[{"{", RowBox[{"1", ",", "2.", ",", "10"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0.", ",", RowBox[{"\[Pi]", "/", "2"}], ",", "16"}], "}"}]}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"gridmap", "=", RowBox[{ RowBox[{"First", "[", RowBox[{"PolarGrid", "[", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "8"}], "}"}], ",", RowBox[{"{", "grid", "}"}]}], "]"}], "]"}], "//", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", "8"}], "]"}]}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxisInside", " ", "=", " ", RowBox[{"{", RowBox[{"CadmiumLemon", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{ RowBox[{"ComplexLine", "[", RowBox[{"{", RowBox[{"0.5", ",", " ", "1"}], "}"}], "]"}], " ", "//", " ", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", " ", "8"}], "]"}]}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"xAxisOutside", " ", "=", " ", RowBox[{"{", RowBox[{"MediumSeaGreen", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{ RowBox[{"ComplexLine", "[", RowBox[{"{", RowBox[{"1.", ",", " ", "2."}], "}"}], "]"}], " ", "//", " ", RowBox[{"FineGrainLines", "[", RowBox[{"0.02", ",", " ", "8"}], "]"}]}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"quarterCircle", " ", "=", " ", RowBox[{"{", RowBox[{"Purple", ",", " ", RowBox[{"Thickness", "[", "0.01", "]"}], ",", " ", RowBox[{"ComplexCurve", "[", RowBox[{ RowBox[{"Exp", "[", RowBox[{"\[Theta]", " ", "I"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"\[Theta]", ",", " ", "0", ",", " ", RowBox[{"\[Pi]", "/", "2"}]}], "}"}]}], "]"}]}], "}"}]}], " ", ";"}]}], "Input"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"TwoPanelAnimation", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"#", "&"}], "}"}], ",", "\[IndentingNewLine]", "RiemannSphere", ",", " ", "rotation", ",", " ", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", "]"}], ",", " ", RowBox[{"{", RowBox[{ "gridmap", ",", " ", "xAxisInside", ",", " ", "xAxisOutside", ",", " ", "quarterCircle"}], "}"}]}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"PlotRegion", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}]}], "}"}]}], ",", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}]}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"f", "[", "#", "]"}], "&"}], "}"}], ",", "\[IndentingNewLine]", "RiemannSphere", ",", " ", "rotation", ",", " ", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"ColoredRiemannSphere", "[", "]"}], ",", " ", RowBox[{"{", RowBox[{ "gridmap", ",", " ", "xAxisInside", ",", " ", "xAxisOutside", ",", " ", "quarterCircle"}], "}"}]}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"PlotRegion", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "1.1"}], "}"}]}], "}"}]}], ",", RowBox[{"ViewPoint", "\[Rule]", " ", RowBox[{"{", RowBox[{"2.486", ",", " ", "1.127", ",", " ", "1.5"}], "}"}]}]}], "}"}]}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"12", "*", "72"}]}]}], "]"}], "[", "18", "]"}], ";"}]], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Reference", "Section", CellChangeTimes->{{3.49609349796875*^9, 3.49609349940625*^9}}], Cell[TextData[{ "[1] Murray Eisenberg and David J. M. Park, Jr., Visualizing Complex \ Functions with the ", StyleBox["Presentations", FontSlant->"Italic"], " Application, ", StyleBox["The Mathematica Journal", FontSlant->"Italic"], " ", StyleBox["11", FontWeight->"Bold"], ", no. 2 (2009), 226\[Dash]252." }], "Text", CellChangeTimes->{{3.496093508640625*^9, 3.496093582328125*^9}, { 3.496093626765625*^9, 3.4960936443125*^9}}, CellTags->"MeAndParkTMJ11#2"] }, Closed]] }, Open ]] }, AutoGeneratedPackage->None, InitializationCellEvaluation->True, WindowSize->{680, 560}, WindowMargins->{{134, Automatic}, {Automatic, 35}}, FrontEndVersion->"7.0 for Microsoft Windows (32-bit) (February 18, 2009)", StyleDefinitions->Notebook[{ Cell[ StyleData[StyleDefinitions -> "Default.nb"]], Cell[ CellGroupData[{ Cell["Style Environment Names", "Section"], Cell[ StyleData[All, "Working"], Background -> RGBColor[0.9921568627450981, 0.9607843137254902, 0.9019607843137255]], Cell[ StyleData[All, "Presentation"], Background -> RGBColor[0.9921568627450981, 0.9607843137254902, 0.9019607843137255]], Cell[ StyleData[All, "SlideShow"], Background -> RGBColor[0.9921568627450981, 0.9607843137254902, 0.9019607843137255]], Cell[ StyleData[All, "Condensed"], Background -> RGBColor[0.9921568627450981, 0.9607843137254902, 0.9019607843137255]], Cell[ StyleData[All, "Printout"], Background -> None]}, Closed]], Cell[ CellGroupData[{ Cell["Notebook Options Settings", "Section"], Cell[ StyleData["Notebook"], ShowCellBracket -> Automatic, InputAliases -> {"intt" -> RowBox[{"\[Integral]", RowBox[{"\[SelectionPlaceholder]", RowBox[{"\[DifferentialD]", "\[Placeholder]"}]}]}], "dintt" -> RowBox[{ SubsuperscriptBox[ "\[Integral]", "\[SelectionPlaceholder]", "\[Placeholder]"], RowBox[{"\[Placeholder]", RowBox[{"\[DifferentialD]", "\[Placeholder]"}]}]}], "sumt" -> RowBox[{ UnderoverscriptBox["\[Sum]", RowBox[{"\[SelectionPlaceholder]", "=", "\[Placeholder]"}], "\[Placeholder]"], "\[Placeholder]"}], "prodt" -> RowBox[{ UnderoverscriptBox["\[Product]", RowBox[{"\[SelectionPlaceholder]", "=", "\[Placeholder]"}], "\[Placeholder]"], "\[Placeholder]"}], "dt" -> RowBox[{ SubscriptBox["\[PartialD]", "\[Placeholder]"], " ", "\[SelectionPlaceholder]"}], "prime" -> "\:02b9", "dprime" -> "\:02ba"}, Magnification -> 1.04]}, Closed]], Cell[ CellGroupData[{ Cell["Styles for Title and Section Cells", "Section"], Cell[ CellGroupData[{ Cell[ StyleData["Title"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {0, 5}}, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, FontFamily -> "Helvetica", FontSize -> 36, FontWeight -> "Bold", FontColor -> GrayLevel[0], Background -> RGBColor[0.737255, 0.894118, 0.807843]], Cell[ StyleData["Title", "Printout"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {0, 5}}, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, FontFamily -> "Helvetica", FontSize -> 26, FontWeight -> "Bold", FontColor -> GrayLevel[0], Background -> None]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["Subtitle"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {0, 0}}, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, FontFamily -> "Helvetica", FontSize -> 24, Background -> RGBColor[0.815686, 0.901961, 0.92549]], Cell[ StyleData["Subtitle", "Printout"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {0, 0}}, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, FontFamily -> "Helvetica", FontSize -> 18, Background -> None]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["Chaptertitle"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {0, 0}}, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1170, FontFamily -> "Helvetica", FontSize -> 24, Background -> RGBColor[0.941176, 0.87451, 0.784314]], Cell[ StyleData["Chaptertitle", "Printout"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {0, 0}}, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1170, FontFamily -> "Helvetica", FontSize -> 18, Background -> None]}, Open]], Cell[ StyleData["Subsubtitle"], ShowCellBracket -> False, CellMargins -> {{12, Inherited}, {20, 5}}, FontFamily -> "Helvetica", FontSize -> 14, FontWeight -> "Bold", FontSlant -> "Plain"], Cell[ StyleData["Section"], CellFrame -> False, ShowGroupOpener -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}], Cell[ StyleData["Subsection"], CellDingbat -> "", ShowGroupOpener -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}], Cell[ StyleData["Subsubsection"], CellDingbat -> "", ShowGroupOpener -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}], Cell[ StyleData["Subsubsubsection"], CellDingbat -> "", ShowGroupOpener -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1360], Cell[ StyleData["Subsubsubsubsection"], ShowGroupOpener -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1370]}, Closed]], Cell[ CellGroupData[{ Cell["Styles for Body Text", "Section"], Cell[ CellGroupData[{ Cell[ StyleData["Text"], AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, FontSize -> 14], Cell[ StyleData["Text", "Printout"], AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, FontSize -> 10]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["EvaluatableText", StyleDefinitions -> StyleData["Text"]], Evaluator -> None, Evaluatable -> True, MenuPosition -> 1405], Cell[ StyleData["EvaluatableText", "Printout"], Evaluator -> None, Evaluatable -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1405, FontSize -> 10]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["EmphasisText", StyleDefinitions -> StyleData["Text"]], CellFrame -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1410, FontFamily -> "Helvetica", FontSize -> 14], Cell[ StyleData["EmphasisText", "Printout"], CellFrame -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1410, FontFamily -> "Helvetica", FontSize -> 10]}, Open]], Cell[ StyleData["BlueComments", StyleDefinitions -> StyleData["Text"]], AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1420, FontSize -> 14, Background -> RGBColor[0.941207, 0.972503, 1]], Cell[ CellGroupData[{ Cell[ StyleData[ "Exercise", StyleDefinitions -> StyleData["BlueComments"]], CellFrame -> True, TextJustification -> 0.5, Hyphenation -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, CounterIncrements -> "Exercise", MenuPosition -> 1425, FontSize -> 14, Background -> RGBColor[0.941207, 0.972503, 1]], Cell[ StyleData[ "Exercise", "Printout", StyleDefinitions -> StyleData["Text"]], CellFrame -> True, TextJustification -> 0.5, Hyphenation -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, CounterIncrements -> "Exercise", MenuPosition -> 1425, FontSize -> 10], Cell[ StyleData[ "BlueComments", "Printout", StyleDefinitions -> StyleData["Text"]], CellMargins -> {{2, 2}, {6, 6}}, TextJustification -> 0.5, Hyphenation -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1420, FontSize -> 10]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["PinkComments", StyleDefinitions -> StyleData["Text"]], AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1430, FontSize -> 14, Background -> RGBColor[1, 0.894102, 0.882399]], Cell[ StyleData[ "PinkComments", "Printout", StyleDefinitions -> StyleData["Text"]], CellMargins -> {{2, 2}, {6, 6}}, TextJustification -> 0.5, Hyphenation -> True, AutoItalicWords -> {"Presentations", "Mathematica", "Tensorial"}, MenuPosition -> 1430, FontSize -> 10]}, Open]]}, Closed]], Cell[ CellGroupData[{ Cell["Styles for Input and Output Cells", "Section"], Cell[ CellGroupData[{ Cell[ StyleData["Input"], FontSize -> 13, FontWeight -> "Bold", Background -> RGBColor[0.976471, 0.909804, 0.815686]], Cell[ StyleData["Input", "Printout"], FontSize -> 10, FontWeight -> "Bold", Background -> None]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["Output"], FontSize -> 14, FontWeight -> "Bold"], Cell[ StyleData["Output", "Printout"], FontSize -> 10, FontWeight -> "Bold"]}, Open]], Cell[ CellGroupData[{ Cell[ StyleData["MSG"], FontSize -> 14], Cell[ StyleData["MSG", "Printout"], FontSize -> 10]}, Open]]}, Closed]]}, Visible -> False, FrontEndVersion -> "7.0 for Microsoft Windows (32-bit) (February 18, 2009)", StyleDefinitions -> "Default.nb"] ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{ "formula"->{ Cell[64669, 1919, 1317, 45, 141, "Exercise", CellTags->"formula"]}, "initialization"->{ Cell[6505, 201, 261, 5, 36, "Section", CellTags->"initialization"]}, "MeAndParkTMJ11#2"->{ Cell[132214, 3839, 475, 15, 53, "Text", CellTags->"MeAndParkTMJ11#2"]} } *) (*CellTagsIndex CellTagsIndex->{ {"formula", 142921, 4083}, {"initialization", 143015, 4086}, {"MeAndParkTMJ11#2", 143112, 4089} } *) (*NotebookFileOutline Notebook[{ Cell[545, 20, 148, 2, 44, "Subsubtitle"], Cell[CellGroupData[{ Cell[718, 26, 85, 2, 44, "Subtitle"], Cell[806, 30, 126, 2, 44, "Subsubtitle"], Cell[935, 34, 225, 6, 24, "SmallText"], Cell[CellGroupData[{ Cell[1185, 44, 97, 1, 67, "Section"], Cell[1285, 47, 1468, 44, 128, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[2790, 96, 146, 2, 36, "Section"], Cell[CellGroupData[{ Cell[2961, 102, 141, 2, 64, "Subsection"], Cell[3105, 106, 477, 12, 66, "Text"], Cell[3585, 120, 1266, 31, 116, "Text"], Cell[4854, 153, 558, 15, 93, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[5449, 173, 98, 1, 40, "Subsection"], Cell[5550, 176, 906, 19, 121, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[6505, 201, 261, 5, 36, "Section", CellTags->"initialization"], Cell[6769, 208, 774, 15, 130, "Text"], Cell[7546, 225, 222, 5, 56, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[7805, 235, 181, 5, 36, "Section"], Cell[7989, 242, 904, 30, 112, "Text"], Cell[8896, 274, 1320, 49, 125, "Text"], Cell[10219, 325, 538, 19, 62, "Text"], Cell[10760, 346, 1645, 40, 333, "Input"], Cell[12408, 388, 636, 16, 85, "Text"], Cell[13047, 406, 275, 7, 62, "Text"], Cell[13325, 415, 368, 12, 63, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[13730, 432, 37, 0, 36, "Section"], Cell[13770, 434, 1475, 50, 54, "Text"], Cell[15248, 486, 969, 29, 52, "Text"], Cell[16220, 517, 1036, 31, 73, "Text"], Cell[17259, 550, 575, 12, 149, "Input"], Cell[17837, 564, 397, 11, 31, "Text"], Cell[18237, 577, 410, 14, 31, "Text"], Cell[CellGroupData[{ Cell[18672, 595, 128, 1, 38, "Subsection"], Cell[18803, 598, 341, 9, 31, "Text"], Cell[19147, 609, 793, 17, 169, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[19977, 631, 135, 1, 30, "Subsection"], Cell[20115, 634, 1231, 44, 87, "Text"], Cell[21349, 680, 1751, 46, 193, "Text"], Cell[23103, 728, 717, 17, 55, "Text"], Cell[23823, 747, 734, 17, 75, "Text"], Cell[24560, 766, 3169, 68, 338, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[27766, 839, 244, 7, 31, "Subsection"], Cell[28013, 848, 568, 15, 55, "Text"], Cell[28584, 865, 103, 1, 49, "Input"], Cell[28690, 868, 686, 14, 154, "Input"], Cell[29379, 884, 882, 29, 74, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[30298, 918, 127, 1, 30, "Subsection"], Cell[30428, 921, 1635, 52, 74, "Text"], Cell[32066, 975, 460, 10, 54, "Text"], Cell[32529, 987, 2165, 47, 238, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[34743, 1040, 133, 1, 36, "Section"], Cell[34879, 1043, 994, 31, 57, "Text"], Cell[CellGroupData[{ Cell[35898, 1078, 124, 1, 38, "Subsection"], Cell[36025, 1081, 788, 23, 52, "Text"], Cell[36816, 1106, 166, 4, 64, "Input"], Cell[36985, 1112, 86, 1, 31, "Text"], Cell[37074, 1115, 215, 5, 48, "Input"], Cell[37292, 1122, 1229, 42, 52, "Text"], Cell[38524, 1166, 593, 17, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[39154, 1188, 318, 8, 30, "Subsection"], Cell[39475, 1198, 819, 27, 31, "Text"], Cell[40297, 1227, 245, 6, 48, "Input"], Cell[40545, 1235, 138, 2, 31, "Text"], Cell[40686, 1239, 223, 5, 48, "Input"], Cell[40912, 1246, 707, 22, 32, "Text"], Cell[41622, 1270, 937, 31, 52, "Text"], Cell[42562, 1303, 4846, 122, 569, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[47445, 1430, 159, 2, 30, "Subsection"], Cell[47607, 1434, 1021, 30, 77, "Text"], Cell[48631, 1466, 1112, 32, 81, "Text"], Cell[49746, 1500, 1985, 57, 76, "Text"], Cell[51734, 1559, 251, 5, 31, "Text"], Cell[51988, 1566, 4127, 115, 589, "Input"], Cell[56118, 1683, 1705, 56, 96, "Text"], Cell[57826, 1741, 502, 12, 52, "Text"], Cell[58331, 1755, 6335, 162, 789, "Input"], Cell[64669, 1919, 1317, 45, 141, "Exercise", CellTags->"formula"] }, Closed]], Cell[CellGroupData[{ Cell[66023, 1969, 141, 1, 30, "Subsection"], Cell[66167, 1972, 349, 7, 52, "Text"], Cell[66519, 1981, 6511, 177, 869, "Input"], Cell[73033, 2160, 957, 28, 132, "Exercise"], Cell[73993, 2190, 712, 22, 132, "Exercise"], Cell[74708, 2214, 814, 23, 132, "Exercise"], Cell[75525, 2239, 807, 23, 112, "Exercise"] }, Closed]], Cell[CellGroupData[{ Cell[76369, 2267, 161, 3, 30, "Subsection"], Cell[76533, 2272, 969, 22, 100, "Text"], Cell[77505, 2296, 656, 16, 54, "Text"], Cell[78164, 2314, 1175, 37, 58, "Text"], Cell[79342, 2353, 4324, 107, 209, "Input"], Cell[83669, 2462, 1548, 35, 89, "Input"], Cell[85220, 2499, 582, 16, 31, "Text"], Cell[85805, 2517, 496, 18, 31, "Text"], Cell[86304, 2537, 1429, 27, 129, "Input"], Cell[87736, 2566, 566, 15, 52, "Text"], Cell[88305, 2583, 423, 12, 31, "Text"], Cell[88731, 2597, 370, 8, 48, "Input"], Cell[89104, 2607, 1030, 26, 92, "Text"], Cell[90137, 2635, 1621, 36, 269, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[91807, 2677, 502, 16, 68, "Section"], Cell[CellGroupData[{ Cell[92334, 2697, 54, 0, 38, "Subsection"], Cell[92391, 2699, 297, 9, 31, "Text"], Cell[92691, 2710, 145, 3, 48, "Input"], Cell[92839, 2715, 167, 4, 48, "Input"], Cell[CellGroupData[{ Cell[93031, 2723, 139, 5, 27, "Subsubsection"], Cell[93173, 2730, 568, 14, 54, "Text"], Cell[93744, 2746, 557, 19, 52, "Text"], Cell[94304, 2767, 6711, 167, 469, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[101052, 2939, 140, 5, 27, "Subsubsection"], Cell[101195, 2946, 1242, 39, 61, "Text"], Cell[102440, 2987, 273, 5, 52, "Text"], Cell[102716, 2994, 3759, 77, 329, "Input"], Cell[106478, 3073, 211, 4, 31, "Text"], Cell[106692, 3079, 1667, 42, 89, "Input"], Cell[108362, 3123, 2127, 69, 214, "Text"], Cell[110492, 3194, 567, 19, 35, "Text"], Cell[111062, 3215, 243, 7, 48, "PinkComments"], Cell[111308, 3224, 188, 4, 19, "Text", CellOpen->False], Cell[111499, 3230, 4894, 132, 19, "Input", CellOpen->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[116442, 3368, 56, 0, 38, "Subsection"], Cell[116501, 3370, 41, 0, 31, "Text"], Cell[116545, 3372, 110, 3, 64, "Input"], Cell[116658, 3377, 516, 14, 52, "Text"], Cell[CellGroupData[{ Cell[117199, 3395, 139, 5, 27, "Subsubsection"], Cell[117341, 3402, 2565, 74, 189, "Input"], Cell[119909, 3478, 1155, 29, 189, "Input"], Cell[121067, 3509, 1070, 39, 87, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[122174, 3553, 140, 5, 27, "Subsubsection"], Cell[122317, 3560, 197, 6, 31, "Text"], Cell[122517, 3568, 2655, 68, 389, "Input"], Cell[125175, 3638, 1331, 38, 248, "Text"], Cell[126509, 3678, 170, 3, 31, "Text"], Cell[126682, 3683, 2565, 74, 189, "Input"], Cell[129250, 3759, 2808, 70, 420, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[132119, 3836, 92, 1, 36, "Section"], Cell[132214, 3839, 475, 15, 53, "Text", CellTags->"MeAndParkTMJ11#2"] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)