(************** Content-type: application/mathematica ************** Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 27049, 750]*) (*NotebookOutlinePosition[ 28144, 786]*) (* CellTagsIndexPosition[ 28100, 782]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Topology and ", StyleBox["Mathematica", FontSlant->"Italic"], " " }], "Title", TextAlignment->Center, TextJustification->0], Cell["Andrzej Kozlowski", "Author"], Cell["\<\ Toyama University of International Studies andrzej@tuins.ac.jp http://sigma0.tuins.ac.jp/~andrzej/ \ \>", "Address"], Cell[CellGroupData[{ Cell["Introduction.", "Subtitle"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " is a marvelous tool for teaching almost all areas of mathematics but it \ appears to be relatively little used in topology, unlike for example, in \ differential geometry ([1],[6]).\n At least a part of the reason lies in the \ general difficulty in using one of the program's strongest points, its \ ability to perform efficiently numerical computations with functions like \ NSolve, NDSolve etc. The study of global properties of topological spaces \ generally requires perfectly accurate information, and in particular the \ ability to solve equations exactly. This is unfortunately impossible in most \ interesting cases. Nevertheless one can often get around this problem [3]. \ Here we try to demonstrate this one example: Morse theory on a closed surface \ (in our case a torus).\nThe basic problem of topology is to decide when two \ spaces are topologially equivalent, that is one one can be continuously \ deformed into the other. Before we can study such a problem with a computer \ we have to convert it into a discrete one. The most commonly used method is \ to represent the space as a union of polygons and then compute topological \ invariants of the space using the combinatorial structure of vertices, edges, \ faces etc. The most basic and famous topological invariant the Euler \ characteristic was originally defined in this way. ", StyleBox["Mathematica", FontSlant->"Italic"], " can indeed be used to compute the Euler characteristic of surfaces by \ means of this method ([3]). However, here we shall study the topology of \ surfaces (including the Euler Characteristic) in a different way. We shall \ concentrate on only one closed surface: the torus. However, everything we do \ here for the torus can be done with ", StyleBox["Mathematica", FontSlant->"Italic"], " for all other closed surfaces ([3]).\n\nWe shall use throughout a fixed \ embedding of the torus in ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalR]\^3\)]], ":" }], "Text"], Cell[BoxData[ \(TraditionalForm\`{\[Theta], \[Phi]} \[RightTeeArrow] {\((cos(\[Theta]) \ + 4)\)\ \(cos(\[Phi])\), sin(\[Theta]), \((cos(\[Theta]) + 4)\)\ \(sin(\[Phi])\)}\)], "Input", CellLabel->"In[72]:=", TextAlignment->Center, TextJustification->0], Cell[BoxData[ \(TraditionalForm\`tor(\[Theta]_, \[Phi]_) := {\((cos(\[Theta]) + 4)\)\ \(cos(\[Phi])\), sin(\[Theta]), \((cos(\[Theta]) + 4)\)\ \(sin(\[Phi])\)}\)], "Input", CellLabel->"In[73]:="], Cell[BoxData[ \(TraditionalForm\`\(torus(a_ : \(-\[Pi]\), b_ : \[Pi], c_ : \(-\[Pi]\), d_ : \[Pi], plotpoints_ : {40, 20}) := ParametricPlot3D[ Evaluate[tor(\[Theta], \[Phi])], {\[Phi], c, d}, {\[Theta], a, b}, PlotPoints \[Rule] plotpoints, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity];\)\)], "Input",\ CellLabel->"In[74]:="], Cell["\<\ Here we display this torus together with the images of the \[Theta] \ and the \[Phi] axes.\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`\(Show[TorusAndAxes, ViewPoint \[Rule] {2.382, \(-2.224\), 0.910}, disp];\)\)], "Input", CellLabel->"In[75]:="] }, Open ]], Cell[CellGroupData[{ Cell["Morse Theory", "Subtitle"], Cell[TextData[{ "Representing a topological space by a finite polyhedron is not the only \ way to \"discretise\" the topological information in such a way that it can \ be dealt it by a computer. Another rather remarkable approach is offered by \ Morse Theory [4]. Basically Morse Theory can be thought of as a \ generalization of the classical theory of critical points (maxima, minima and \ saddle points) of smooth functions on Euclidean spaces. It turns out that \ for a generic function defined on a closed compact manifold (e.g. a closed \ surface)) the nature of its critical points determines a great deal of (and \ in some sense all) the topology of the manifold. The most common way to do so \ is by choosing a \"height\" function for some embedding of the manifold in ", Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalR]\^n\)\(.\)\)\)]] }], "Text"], Cell["\<\ In the case of our torus let us take as the height function the \ natural one, that is the z coordinate. The function is defined globally on \ the torus in terms of the parametric coordinates.\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`height(\[Theta]_, \[Phi]_) := \(tor(\[Theta], \ \[Phi])\)\[LeftDoubleBracket]3\[RightDoubleBracket]\)], "Input", CellLabel->"In[76]:=", TextAlignment->Center, TextJustification->0], Cell["\<\ Clearly the values of the \"height\" function lie in the range \ between -5 and 5. \ \>", "Text"], Cell[CellGroupData[{ Cell["Critical Points", "Subsection"], Cell[TextData[{ "We would like to do calculus on the torus and find the critical points of \ the height function. Basically this is the same as thing that one does in \ differential calculus of a function of several variables (in this case 2) \ except that we cannot use global coordinates. (The parametric coordinates are \ not uniquely determined by the points on the torus). But there is a standard \ way to do differential calculus on such a surface: we cover it with \ overlapping patches, each homeomorphic to a open rectangle in ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalR]\^2\)]], "and such that the \"transitions\" between them define differentiable \ functions in a rectangle in ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalR]\^2\)]], ". This makes it possible to consider the restriction of a smooth function \ to a patch as a function on a rectangle. We can then differentiate it as \ usual and the result does not depend on the choice of patches. We shall work \ in four (overlapping) rectangular coordinate patches. Each of the above \ regions can be identified with the rectangle:", Cell[BoxData[ \(TraditionalForm\`{\(-\(\[Pi]\/2\)\) - 0.1 \[LessEqual] \[Theta] \[LessEqual] \[Pi]\/2 + 0.1, \(-\(\[Pi]\/2\)\) - 0.1 \[LessEqual] \[Phi] \[LessEqual] \[Pi]\/2 + 0.1}\)]], "by a translation in the coordinates. After this identification the height \ function is replaced by four different \"local\" height functions." }], "Text"], Cell[BoxData[ FormBox[ RowBox[{\(\(T(\[Alpha]_, \[Beta]_)\)\[InvisibleApplication] \ \((\[Theta]_, \[Phi]_)\) := {\[Alpha] + \[Theta], \[Beta] + \[Phi]}\), ";", RowBox[{"trans", "=", RowBox[{"Apply", "[", RowBox[{"T", ",", RowBox[{"Distribute", "[", RowBox[{ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\[Pi]\/2\), \(-\(\[Pi]\/2\)\)}, {\(\[Pi]\/2\), \(-\(\[Pi]\/2\)\)} }], "\[NoBreak]", ")"}], ",", "List"}], "]"}], ",", \({1}\)}], "]"}]}], ";", \(\(height( i_)\)\[InvisibleApplication] \((\[Theta]_, \[Phi]_)\) := height @@ \(trans\[LeftDoubleBracket] i\[RightDoubleBracket]\)[\[Theta], \[Phi]]\), ";"}], TraditionalForm]], "Input", CellLabel->"In[114]:="], Cell["\<\ The critical points of a function are the points where the gradient \ takes the value 0. We first define the gradient:\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`gradient(f_, {\[Theta]__}) := Through[\(Through[\(Apply[Derivative, IdentityMatrix[Length[{\[Theta]}]], {1}]\)[ f]]\)[\[Theta]]]\)], "Input", CellLabel->"In[115]:="], Cell["\<\ Next we look for the critical points and remove from the list of \ solutions anything containing complex numbers.\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`solrules = DeleteCases[\((Solve[ gradient(height(#1), {\[Theta], \[Phi]}) == 0, {\[Theta], \[Phi]}] &)\) /@ Range[4], {\[Phi] \[Rule] x_, \[Theta] \[Rule] y_} /; \[Not] \((Im(x) == 0 \[And] Im(y) == 0)\), \[Infinity]]\)], "Input", CellLabel->"In[116]:="], Cell["\<\ Although these look all like the same solutions we must remember \ that they have to converted back into their correct parameters on the torus. \ We remove any possible duplicates and arrange the solutions according to the \ value of the height function:\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`StandardForm[ solutions = Sort[Flatten[\((Apply[#1, {\[Theta], \[Phi]} \ /. \[InvisibleSpace]solrules\[LeftDoubleBracket]1\[RightDoubleBracket], {1}] \ &)\) /@ trans, 1] \[Union] \((SameTest \[Rule] \((tor @@ #1 == tor @@ #2 &)\))\), height @@ #1 > height @@ #2 &]]\)], "Input", CellLabel->"In[117]:="], Cell["We check that these indeed are the critical points:", "Text"], Cell[BoxData[ \(TraditionalForm\`gradient( height, {\[Theta], \[Phi]}) /. \[InvisibleSpace]\((Thread[{\[Theta], \ \[Phi]} \[Rule] #1] &)\) /@ solutions\)], "Input", CellLabel->"In[118]:="], Cell["\<\ We calculate the heights (critical values), which are exactly as we \ would expect:\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`heights = Apply[height, solutions, {1}]\)], "Input", CellLabel->"In[119]:="], Cell["\<\ Let us also look at some pictures of the torus and the critical \ points. If we wish to see all the critical points we can simply convert all \ the polygons into lines, which will make the torus transparent:\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`\(criticalpoints = Graphics3D[\(({RGBColor[1, 0, 0], PointSize[0.04], Point[#1]} &)\) /@ \((tor(\[Theta], \[Phi]) \ /. \[InvisibleSpace]\((Thread[{\[Theta], \[Phi]} \[Rule] #1] &)\) /@ solutions)\), Boxed \[Rule] False];\)\)], "Input", CellLabel->"In[120]:="], Cell[BoxData[ \(\(Show[{torus[\(-\[Pi]\), \[Pi], \(-\[Pi]\), \[Pi]] \ /. \[InvisibleSpace]Polygon[l_] \[Rule] {RGBColor[0, 1, 0], Line[l]}, criticalpoints}, disp, Boxed \[Rule] False, PlotRange \[Rule] All];\)\)], "Input", CellLabel->"In[121]:="], Cell["\<\ Note that all the critical points we have found are \"isolated\". \ This is required of a \"Morse\" function. One can show that the set of \ functions for which this condition is satisfied is dense in the space of all \ smooth functions on a compact manifold.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["The Index of a critical point.", "Subsection"], Cell[TextData[{ "If ", Cell[BoxData[ \(TraditionalForm\`P\)]], " is a critical point of a smooth function ", Cell[BoxData[ \(TraditionalForm\`f\)]], ", the Hessian of ", Cell[BoxData[ \(TraditionalForm\`f\)]], " at P is the symmetric matrix of second derivatives." }], "Text"], Cell[BoxData[ RowBox[{"(", "\[NoBreak]", RowBox[{GridBox[{ { FractionBox[\(\[PartialD]\^2 f\), \(\[PartialD]x\_i\[ThinSpace]\[PartialD]x\_j\), MultilineFunction->None]} }], \((P)\)}], "\[NoBreak]", ")"}]], "DisplayFormula", CellLabel->"In[26]:=", TextAlignment->Left, TextJustification->0], Cell["\<\ This definition (the matrix ) depends on the choice of coordinates at P, but \ the corresponding symmetric bilinear form (on the tangent space) is \ independent of the choice of local coordinates. We can define the Hessian as:\ \ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`Hessian(f_, {x__}) := Flatten[Outer[D, {f}, {x}, {x}], 1]\)], "Input", CellLabel->"In[122]:="], Cell["We can compute the Hessians at all our critical points:", "Text"], Cell[BoxData[ \(TraditionalForm\`MatrixForm /@ \((hessians = Hessian(height(\[Theta], \[Phi]), {\[Theta], \[Phi]}) \ /. \[InvisibleSpace]\((Thread[{\[Theta], \[Phi]} \[Rule] #1] &)\) /@ solutions)\)\)], "Input", CellLabel->"In[123]:="], Cell[TextData[{ "A critical point is said to be non-degenerate if its Hessian has maximal \ rank, i.e. its NullSpace is zero. Again, this is easy to check with ", StyleBox["Mathematica", FontSlant->"Italic"], ":" }], "Text"], Cell[BoxData[ \(TraditionalForm\`NullSpace /@ hessians\)], "Input", CellLabel->"In[124]:="], Cell["\<\ A function all of whose critical points are isolated and \ non-degenerate is called a Morse function. So the height function given by \ the z coordinate is indeed a Morse function. \ \>", "Text"], Cell["\<\ The index of a non-degenerate critical point is defined as the \ number of negative eigenvalues of the Hessian:\ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`index(f_, x_List, a_List) := Count[Eigenvalues[ Hessian(f, x) /. \[InvisibleSpace]Thread[x \[Rule] a]], _? Negative]\)], "Input", CellLabel->"In[125]:="], Cell["Here are the indices of our four critical points.", "Text"], Cell[BoxData[ \(TraditionalForm\`indices = \((index(height(x, y), {x, y}, #1) &)\) /@ solutions\)], "Input", CellLabel->"In[126]:="], Cell[BoxData[ \(TraditionalForm\`MorsePolynomial(indices_List, t_) := \[Sum]\+\(i = Min(indices)\)\%\(Max(indices)\)Count[indices, i]\ t\^i\)], "Input", CellLabel->"In[127]:="], Cell[BoxData[ \(TraditionalForm\`MorsePolynomial(indices, t)\)], "Input", CellLabel->"In[128]:="], Cell["\<\ The Morse polynomial of a Morse function contains a lot of \ information about the topology of the manifold. In particular, the following \ theorem is a special case of the famous Hopf index theorem:\ \>", "Text"], Cell[CellGroupData[{ Cell[TextData[{ "Theorem\nLet ", Cell[BoxData[ \(TraditionalForm\`\(\(M\)\(\[Subset]\)\(\ \)\)\)]], Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalR]\^n\)]], "be a compact ", Cell[BoxData[ \(TraditionalForm\`C\^\[Infinity]\)]], "submanifold and ", Cell[BoxData[ \(TraditionalForm\`f : M\[LongRightArrow]\[DoubleStruckCapitalR]\)]], " a Morse function. Then the Euler characteristic of ", Cell[BoxData[ \(TraditionalForm\`M\)]], " is equal to the result of substituting -1 in the Morse Polynomial of ", Cell[BoxData[ \(TraditionalForm\`M\)]], "." }], "Subsubsection"], Cell["Indeed", "Text"], Cell[BoxData[ \(TraditionalForm\`MorsePolynomial(indices, \(-1\))\)], "Input", CellLabel->"In[129]:="], Cell["\<\ As is well known this is indeed correct. \ \>", "Text"], Cell[BoxData[ \(\(colors = Join[Table[RGBColor[1, 0, 0], {1}], Table[RGBColor[1, 1, 0], {2}], Table[RGBColor[0, 0, 1], {1}]];\)\)], "Input", CellLabel->"In[130]:="], Cell[BoxData[ \(\(coords = tor @@@ N[solutions] // Chop;\)\)], "Input", CellLabel->"In[131]:="], Cell[BoxData[ \(\(coloredcoords = Transpose[{colors, coords}];\)\)], "Input", CellLabel->"In[132]:="], Cell[BoxData[ \(\(criticalpoints = Graphics3D[\({#1, PointSize[0.02], Point[N[#2]]} &\) @@@ coloredcoords];\)\)], "Input", CellLabel->"In[133]:="], Cell[BoxData[ \(\(Show[{torus[\(-\[Pi]\), \[Pi], \(-\[Pi]\), \[Pi]] \ /. \[InvisibleSpace]Polygon[l_] \[Rule] {RGBColor[0, 1, 0], Line[l]}, criticalpoints}, disp, Boxed \[Rule] False, PlotRange \[Rule] All];\)\)], "Input", CellLabel->"In[134]:="] }, Open ]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Gradient Flows on the Torus", "Subtitle"], Cell[TextData[{ "\nFor any Riemannian manifold ", Cell[BoxData[ \(TraditionalForm\`M\)]], " (a higher dimensional generalization of a surface) a Morse function ", Cell[BoxData[ \(TraditionalForm\`f : \ M\ \[LongRightArrow]\[DoubleStruckCapitalR]\)]], " determines the gradient vector field ", Cell[BoxData[ \(TraditionalForm\`\[Del]f\)]], " on ", Cell[BoxData[ \(TraditionalForm\`M\)]], " . The gradient field at a point \"points\" in the directions of the \ steepest ascent of ", Cell[BoxData[ \(TraditionalForm\`f\)]], " at that point (so ", Cell[BoxData[ \(TraditionalForm\`\(-\[Del]f\)\)]], " points in the direction of the steepest descent). (In general ", Cell[BoxData[ \(TraditionalForm\`\[Del]f\)]], " depends on the Riemannian metric on ", Cell[BoxData[ \(TraditionalForm\`M\)]], ". In the case our case the metric is always the one induced by the \ embedding in ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalR]\^3\)]], ".) By the theorem of local existence of solutions to first-order ordinary \ differential equations, there exists an integral curve \[Gamma] of the vector \ field ", Cell[BoxData[ \(TraditionalForm\`\(-\[Del]f\)\)]], " through any point of ", Cell[BoxData[ \(TraditionalForm\`M\)]], " , given locally by the solutions of the differential equation:" }], "Text", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ RowBox[{"\[NoBreak]", GridBox[{ { RowBox[{ RowBox[{ FractionBox[\(\[PartialD]\[Gamma] \((t)\)\), \(\[PartialD]t\), MultilineFunction->None], "=", \(-\((\[Del]f)\)\[InvisibleApplication] \((\[Gamma] \ \((t)\))\)\)}], ","}], \(\[Gamma] \((0)\) = P\)} }]}]], "DisplayFormula", Editable->False, Evaluatable->False, FontFamily->"Times New Roman", FontWeight->"Bold"], Cell[TextData[{ "It is well known that domain the solutions of these equations can be \ extended to the whole of ", Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalR]\)\(.\)\)\)]], " They can be thought of as infinite \"flows\", which begin at one \ critical point and end at another. It turns out [CJS] that in the \"generic\" \ case, the structure of the flows completely determines the topology of the \ manifold. The equations of gradient flow are in almost all cases too \ complicated to solve exactly with the DSolve function but they can be solved \ numerically with the NDSolve function. This makes it possible to \"illustrate\ \" the combinatorial structure of the space of flows, but of course not to \ determine it. To see what happens we shall use ", StyleBox["Mathematica", FontSlant->"Italic"], " to compare the structure of flows corresponding to two different Morse \ functions on the torus. The first is the height function on the \"vertical\" \ torus, i.e. the example which we have been considering so far. This is the \ \"non-generic\" case, which means that the structure of flows will be changed \ by the slightest change in the Morse function. To obtain the pictures of the \ gradient flow of the height function on the torus we have to solve a system \ of differential equations with initial conditions determining the \"starting \ point\" of the flow. Since we cannot choose a critical point as our starting \ point (the flows never \"reach\" the critical points), we do the next best \ thing and generate several level curves located conveniently between \ different critical points (using the << Graphics`ImplicitPlot` Standard \ package)." }], "Text"], Cell[BoxData[ \(TraditionalForm\`\(Show[{LevelCurvesOnTorus, criticalpoints}, Boxed \[Rule] False, disp];\)\)], "Input", CellLabel->"In[98]:="], Cell["\<\ We now display the flows which originate on the flow lines together \ with six special flows shown in green. These green flows are the only ones \ whose \"source\" and \"target\" are not the lowest and highest point.\ \>", \ "Text"], Cell[BoxData[ \(TraditionalForm\`\(Show[{FlowsOnTorus, criticalpoints}, disp, PlotRange \[Rule] All, Boxed \[Rule] False, Axes \[Rule] False];\)\)], "Input", CellLabel->"In[99]:="], Cell[TextData[{ "We now want to repeat everything that we did above but we want first to \ peturb the height function slightly. Equivalently, we shall tilt the torus by \ a chosen angle \[Gamma]. In principle any \[Gamma] between ", Cell[BoxData[ \(TraditionalForm\`\(-\[Pi]\)\/2\)]], " and ", Cell[BoxData[ \(TraditionalForm\`\[Pi]\/2\)]], " should give us an equivalent picture but in practice an accurate \ computation, which is essential here, will not be possible unless we choose \ the value of \[Gamma] carefully. For this reason we shall take: " }], "Text"], Cell[BoxData[ \(\[Gamma] = \[Pi]\/6; Rt = FunctionExpand[{{1, 0, 0}, {0, Cos[\[Gamma]], Sin[\[Gamma]]}, {0, \(-Sin[\[Gamma]]\), Cos[\[Gamma]]}}];\)], "Input", CellLabel->"In[100]:="], Cell[BoxData[ \(\(tiltedTor[\[Theta]_, \[Phi]_] := Flatten[Rt . Transpose[{tor[\[Theta], \[Phi]]}]];\)\)], "Input", CellLabel->"In[101]:="], Cell[BoxData[ \(TraditionalForm\`\(tiltedTorus(a_ : \(-\[Pi]\), b_ : \[Pi], c_ : \(-\[Pi]\), d_ : \[Pi]) := ParametricPlot3D[ Evaluate[tiltedTor(\[Theta], \[Phi])], {\[Phi], c, d}, {\[Theta], a, b}, PlotPoints \[Rule] {40, 20}, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity];\)\)], "Input",\ CellLabel->"In[102]:="], Cell["\<\ We display both tori together. The green torus is the tilted one. \ \>", "Text"], Cell[BoxData[ \(\(Show[ tiltedTorus[] /. \[InvisibleSpace]Polygon[ x_] \[Rule] {RGBColor[0, 1, 0], Polygon[x]}, torus[] /. \[InvisibleSpace]Polygon[x_] \[Rule] {RGBColor[1, 0, 0], Polygon[x]}, disp, Lighting \[Rule] False];\)\)], "Input", CellLabel->"In[103]:="], Cell["\<\ Repeating our earlier procedure for the vertical torus we obtain \ the new pictures of the flows. The change in the configuration of flows is \ clearly visible. \ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`\(Show[FlowsOnTiltedTorus, disp, PlotRange \[Rule] All, Boxed \[Rule] False, Axes \[Rule] False];\)\)], "Input", CellLabel->"In[104]:="], Cell["\<\ This time the picture seen from the back is not the same as the one \ seen form the front. \ \>", "Text"], Cell[BoxData[ \(TraditionalForm\`\(Show[%, ViewPoint \[Rule] {0.101, \(-3.364\), 0.346}];\)\)], "Input", CellLabel->"In[105]:="], Cell["", "Text", Selectable->False, ShowCellBracket->False, CellMargins->{{0, 0}, {1, 1}}, CellElementSpacings->{"CellMinHeight"->1}, CellFrameMargins->False, CellFrameColor->RGBColor[0, 0, 1], CellSize->{Inherited, 5}], Cell[BoxData[ \(\(Show[{SpecialFlowsOnTiltedTorus, tiltedCriticals}, disp, PlotRange \[Rule] All, Boxed \[Rule] False, Axes -> False, ViewPoint \[Rule] {0.101, \(-3.364\), 0.346}];\)\)], "Input", CellLabel->"In[106]:="], Cell[BoxData[ \(\(Show[{FlowsOnTiltedTorus2, SpecialFlowsOnTiltedTorus /. Line[x_] \[RuleDelayed] {Thickness[0.01], Line[x]}, tiltedCriticals}, disp, Boxed \[Rule] False, Axes -> False, ViewPoint \[Rule] {0.101, \(-3.364\), 0.346}];\)\)], "Input", CellLabel->"In[107]:="], Cell[BoxData[ \(\(Show[%, ViewPoint \[Rule] {0.101, \(-3.364\), 0.346}, Boxed \[Rule] False, Axes -> False];\)\)], "Input", CellLabel->"In[108]:="], Cell[TextData[{ "These pictures provide a remarkable illustration of a phenomenon which is \ difficult to fully grasp by intuition alone. In this way they vividly display \ the power of ", StyleBox["Mathematica", FontSlant->"Italic"], " as an aid to mathematical intuition. Yet at the same time one has to \ recognize that ultimately they are based on an illusion. A theorem of Smale \ [5] asserts that if we have a two critical points and a third one between \ them then there are always flows which or flow down from the heighest point \ to the lowest and come arbitrarily close to the intermediate point. Thus no \ approximate computation can ever decide if a flow does \"end\" (after \ infinite time) at an intermediate point or will eventully change its mind and \ turn down towards the lowest point. " }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["References", "Subtitle"], Cell[TextData[{ "\n\n1. A. Gray Modern Differential Geometry of Curves and Surfaces with \ ", StyleBox["Mathematica,", FontSlant->"Italic"], " CRC Press 1998\n2. R. Cohen, J. Jones, G. Segal, Morse Theory and \ Classifying Spaces (preprint)\n3. A. Kozlowski, A. Topology with ", StyleBox["Mathematica,", FontSlant->"Italic"], " in preparation\n4. J. Milnor Morse Theory, Princeton University Press, \ 1973\n5. S. Smale On gradient dynamical systems, Annals of Mathematics, 74 \ (1961), 199-206\n6. Y.Tazawa Theory of Curves and Surfaces. An Introduction \ to Classical Differential Geometry by ", StyleBox["Mathematica", FontSlant->"Italic"], " (in Japanese), " }], "Reference"] }, Open ]] }, Open ]] }, FrontEndVersion->"4.1 for Macintosh", ScreenRectangle->{{0, 1152}, {0, 746}}, NotebookAutoSave->False, ScreenStyleEnvironment->"Working", ShowPageBreaks->False, WindowToolbars->{"RulerBar", "EditBar"}, RulerUnits->"Centimeters", WindowSize->{1057, 681}, WindowMargins->{{33, Automatic}, {Automatic, 6}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, PrintingOptions->{"PrintingMargins"->{{54, 54}, {72, 72}}, "PrintCellBrackets"->False, "PrintRegistrationMarks"->False, "PrintMultipleHorizontalPages"->False}, CellLabelAutoDelete->False, AspectRatioFixed->True, StyleDefinitions -> "ArticleClassic.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1727, 52, 154, 7, 79, "Title"], Cell[1884, 61, 35, 0, 40, "Author"], Cell[1922, 63, 127, 6, 84, "Address"], Cell[CellGroupData[{ Cell[2074, 73, 33, 0, 37, "Subtitle"], Cell[2110, 75, 2080, 35, 186, "Text"], Cell[4193, 112, 270, 6, 29, "Input"], Cell[4466, 120, 225, 4, 29, "Input"], Cell[4694, 126, 415, 8, 47, "Input"], Cell[5112, 136, 114, 3, 26, "Text"], Cell[5229, 141, 159, 3, 29, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[5425, 149, 32, 0, 37, "Subtitle"], Cell[5460, 151, 883, 13, 74, "Text"], Cell[6346, 166, 216, 4, 26, "Text"], Cell[6565, 172, 223, 5, 29, "Input"], Cell[6791, 179, 107, 3, 26, "Text"], Cell[CellGroupData[{ Cell[6923, 186, 37, 0, 42, "Subsection"], Cell[6963, 188, 1543, 26, 109, "Text"], Cell[8509, 216, 892, 19, 58, "Input"], Cell[9404, 237, 142, 3, 26, "Text"], Cell[9549, 242, 242, 5, 29, "Input"], Cell[9794, 249, 137, 3, 26, "Text"], Cell[9934, 254, 378, 8, 29, "Input"], Cell[10315, 264, 278, 5, 42, "Text"], Cell[10596, 271, 405, 9, 29, "Input"], Cell[11004, 282, 67, 0, 26, "Text"], Cell[11074, 284, 202, 4, 29, "Input"], Cell[11279, 290, 107, 3, 26, "Text"], Cell[11389, 295, 115, 2, 29, "Input"], Cell[11507, 299, 231, 4, 26, "Text"], Cell[11741, 305, 345, 6, 29, "Input"], Cell[12089, 313, 272, 5, 44, "Input"], Cell[12364, 320, 283, 5, 42, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[12684, 330, 52, 0, 42, "Subsection"], Cell[12739, 332, 310, 11, 26, "Text"], Cell[13052, 345, 394, 11, 41, "DisplayFormula"], Cell[13449, 358, 253, 6, 58, "Text"], Cell[13705, 366, 140, 3, 29, "Input"], Cell[13848, 371, 71, 0, 26, "Text"], Cell[13922, 373, 267, 5, 29, "Input"], Cell[14192, 380, 234, 6, 26, "Text"], Cell[14429, 388, 97, 2, 29, "Input"], Cell[14529, 392, 205, 4, 26, "Text"], Cell[14737, 398, 135, 3, 26, "Text"], Cell[14875, 403, 219, 5, 29, "Input"], Cell[15097, 410, 65, 0, 26, "Text"], Cell[15165, 412, 147, 3, 29, "Input"], Cell[15315, 417, 204, 4, 54, "Input"], Cell[15522, 423, 103, 2, 29, "Input"], Cell[15628, 427, 223, 4, 26, "Text"], Cell[CellGroupData[{ Cell[15876, 435, 634, 19, 48, "Subsubsection"], Cell[16513, 456, 22, 0, 26, "Text"], Cell[16538, 458, 108, 2, 29, "Input"], Cell[16649, 462, 65, 3, 42, "Text"], Cell[16717, 467, 190, 4, 28, "Input"], Cell[16910, 473, 101, 2, 28, "Input"], Cell[17014, 477, 107, 2, 28, "Input"], Cell[17124, 481, 174, 4, 28, "Input"], Cell[17301, 487, 272, 5, 44, "Input"] }, Open ]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[17634, 499, 47, 0, 37, "Subtitle"], Cell[17684, 501, 1472, 41, 90, "Text"], Cell[19159, 544, 520, 15, 35, "DisplayFormula", Evaluatable->False], Cell[19682, 561, 1712, 27, 138, "Text"], Cell[21397, 590, 158, 3, 29, "Input"], Cell[21558, 595, 242, 5, 26, "Text"], Cell[21803, 602, 204, 4, 29, "Input"], Cell[22010, 608, 587, 12, 45, "Text"], Cell[22600, 622, 219, 5, 40, "Input"], Cell[22822, 629, 154, 3, 28, "Input"], Cell[22979, 634, 404, 8, 47, "Input"], Cell[23386, 644, 90, 3, 42, "Text"], Cell[23479, 649, 314, 6, 44, "Input"], Cell[23796, 657, 185, 5, 42, "Text"], Cell[23984, 664, 193, 4, 29, "Input"], Cell[24180, 670, 115, 4, 42, "Text"], Cell[24298, 676, 143, 3, 29, "Input"], Cell[24444, 681, 233, 7, 7, "Text"], Cell[24680, 690, 243, 4, 44, "Input"], Cell[24926, 696, 321, 6, 44, "Input"], Cell[25250, 704, 162, 3, 28, "Input"], Cell[25415, 709, 829, 14, 74, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[26281, 728, 30, 0, 37, "Subtitle"], Cell[26314, 730, 707, 16, 116, "Reference"] }, Open ]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)