Topology and Mathematica

Andrzej Kozlowski

Introduction.

Mathematica 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]).
 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).
The 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. Mathematica 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 Mathematica for all other closed surfaces ([3]).

We shall use throughout a fixed embedding of the torus in (ℝ^3):

{θ, ϕ} ↦ {(cos(θ) + 4) cos(ϕ), 
        sin(θ), (cos(θ) + 4) sin(ϕ)}

tor(θ_, ϕ_) := {(cos(θ) + 
              4) cos(ϕ), 
        sin(θ), (cos(θ) + 4) sin(ϕ)}

torus(a_ : -π, b_ : π, c_ : -π, 
          d_ : π, plotpoints_ : {40, 20}) := 
        ParametricPlot3D[
          Evaluate[tor(θ, ϕ)], {ϕ, c, d}, {θ, a, b}, 
          PlotPoints -> plotpoints, Boxed -> False, 
          Axes -> False, DisplayFunction -> Identity];

Here we display this torus together with the images of the θ and the ϕ axes.

Show[TorusAndAxes, 
        ViewPoint -> {2.382, -2.224, 0.910}, disp];

Morse Theory

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 (ℝ^n).

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.

height(θ_, ϕ_) := tor(θ, ϕ)[[3]]

Clearly the values of the "height" function lie in the range between -5 and 5.

Critical Points

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 (ℝ^2)and such that the "transitions" between them define differentiable functions in a rectangle in (ℝ^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:{-(π/2) - 
            0.1 ≤ θ ≤ (π/2) + 
            0.1, -(π/2) - 
            0.1 ≤ ϕ ≤ (π/2) + 0.1}by a translation in the coordinates. After this identification the height function is replaced by four different "local" height functions.

T(α_, β_) (θ_, ϕ_) := {α + θ, β + ϕ};trans=Apply[T,Distribute[(({{(π/2), -(π/2)}, {(π/2), -(π/2)}})),List],{1}];height(
              i_) (θ_, ϕ_) := 
          height @@ trans[[
                i]][θ, ϕ];

The critical points of a function are the points where the gradient takes the value 0. We first define the gradient:

gradient(f_, {θ__}) := 
      Through[Through[Apply[Derivative, 
                IdentityMatrix[Length[{θ}]], {1}][
              f]][θ]]

Next we look for the critical points and remove from the list of solutions anything containing complex numbers.

solrules = 
      DeleteCases[(Solve[
                gradient(height(#1), {θ, ϕ}) == 
                  0, {θ, ϕ}] &) /@ 
          Range[4], {ϕ -> x_, θ -> 
              y_} /; ¬ (Im(x) == 0 ∧ 
                Im(y) == 0), ∞]

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:

StandardForm[
      solutions = 
        Sort[Flatten[(Apply[#1, {θ, ϕ} /. solrules[[1]], {1}] &) /@ trans, 
              1] ⋃ (SameTest -> (tor @@ #1 == 
                      tor @@ #2 &)), 
          height @@ #1 > height @@ #2 &]]

We check that these indeed are the critical points:

gradient(
        height, {θ, ϕ}) /. (Thread[{θ, ϕ} -> #1] &) /@ solutions

We calculate the heights (critical values), which are exactly as we would expect:

heights = Apply[height, solutions, {1}]

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:

criticalpoints = 
        Graphics3D[({RGBColor[1, 0, 0], PointSize[0.04], 
                  Point[#1]} &) /@ (tor(θ, ϕ) /. (Thread[{θ, ϕ} -> #1] &) /@ 
                  solutions), Boxed -> False];

Show[{torus[-π, π, -π, π] /. Polygon[l_] -> {RGBColor[0, 1, 0], Line[l]}, 
          criticalpoints}, disp, Boxed -> False, 
        PlotRange -> All];

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.

The Index of a critical point.

If  P is a critical point of a smooth function f,  the Hessian of f at P is the symmetric matrix of second derivatives.

(({{(((∂^2) 
                  f)/(∂(Subscript[x, i]) ∂(Subscript[x, j])))}})(P))

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:

Hessian(f_, {x__}) := 
      Flatten[Outer[D, {f}, {x}, {x}], 1]

We can compute the Hessians at all our critical points:

MatrixForm /@ (hessians = 
          Hessian(height(θ, ϕ), {θ, ϕ}) /. (Thread[{θ, ϕ} -> #1] &) /@ 
              solutions)

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 Mathematica:

NullSpace /@ hessians

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.

The index of a non-degenerate critical point is defined as the number of negative eigenvalues of the Hessian:

index(f_, x_List, a_List) := 
      Count[Eigenvalues[
          Hessian(f, x) /. Thread[x -> a]], _?
          Negative]

Here are the indices of our four critical points.

indices = (index(height(x, y), {x, y}, #1) &) /@ 
        solutions

MorsePolynomial(indices_List, 
        t_) := (∑_(i = Min(indices))^(Max(indices)))Count[indices, 
            i] (t^i)

MorsePolynomial(indices, t)

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:

Theorem
Let M⊂ (ℝ^n)be a compact (C^∞)submanifold and f : M⟶ℝ a Morse function. Then the Euler characteristic of M is equal to the result of substituting  -1 in the Morse Polynomial of M.

Indeed

MorsePolynomial(indices, -1)

As is well known this is indeed correct.

colors = 
        Join[Table[RGBColor[1, 0, 0], {1}], Table[RGBColor[1, 1, 0], {2}], 
          Table[RGBColor[0, 0, 1], {1}]];

coords = tor @@@ N[solutions] // Chop;

coloredcoords = Transpose[{colors, coords}];

criticalpoints = 
        Graphics3D[{#1, PointSize[0.02], Point[N[#2]]} & @@@ 
            coloredcoords];

Show[{torus[-π, π, -π, π] /. Polygon[l_] -> {RGBColor[0, 1, 0], Line[l]}, 
          criticalpoints}, disp, Boxed -> False, 
        PlotRange -> All];

Gradient Flows on the Torus

For any Riemannian manifold M (a higher dimensional generalization of a surface) a  Morse function f :  
        M ⟶ℝ determines the gradient vector field ∇f on M . The gradient field  at a point "points" in the directions of the steepest ascent of f at that point (so -∇f points in the direction of the steepest descent). (In general  ∇f  depends on the Riemannian metric on  M.   In the case our case the metric is always the one induced by the embedding in (ℝ^3).) By the theorem of local existence of solutions to first-order ordinary differential equations, there exists an integral curve γ of the vector field -∇f through any point of M , given locally by the solutions of the differential equation:

({{((∂γ (t))/(∂t))=\(-\((∇f)\) \((γ \((t)\))\)\),, γ (0) = P}})

It is well known that domain the solutions of these equations can be extended to the whole of ℝ. 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 Mathematica 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).

Show[{LevelCurvesOnTorus, criticalpoints}, 
        Boxed -> False, disp];

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.

Show[{FlowsOnTorus, criticalpoints}, disp, 
        PlotRange -> All, Boxed -> False, 
        Axes -> False];

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 γ. In principle any γ between ((-π)/2) and (π/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 γ carefully. For this reason we shall take:

γ = (π/6); 
    Rt = FunctionExpand[{{1, 0, 0}, {0, Cos[γ], 
            Sin[γ]}, {0, -Sin[γ], 
            Cos[γ]}}];

tiltedTor[θ_, ϕ_] := 
        Flatten[Rt . Transpose[{tor[θ, ϕ]}]];

tiltedTorus(a_ : -π, b_ : π, 
          c_ : -π, d_ : π) := 
        ParametricPlot3D[
          Evaluate[tiltedTor(θ, ϕ)], {ϕ, c, d}, {θ, 
            a, b}, PlotPoints -> {40, 20}, Boxed -> False, 
          Axes -> False, DisplayFunction -> Identity];

We display both tori together. The green torus is the tilted one.

Show[
        tiltedTorus[] /. Polygon[
              x_] -> {RGBColor[0, 1, 0], Polygon[x]}, 
        torus[] /. Polygon[x_] -> {RGBColor[1, 0, 0], 
              Polygon[x]}, disp, Lighting -> False];

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.

Show[FlowsOnTiltedTorus, disp, 
        PlotRange -> All, Boxed -> False, 
        Axes -> False];

This time the picture seen from the back is not the same as the one seen form the front.

Show[%, 
        ViewPoint -> {0.101, -3.364, 0.346}];

Show[{SpecialFlowsOnTiltedTorus, tiltedCriticals}, disp, 
        PlotRange -> All, Boxed -> False, Axes -> False, 
        ViewPoint -> {0.101, -3.364, 0.346}];

Show[{FlowsOnTiltedTorus2, 
          SpecialFlowsOnTiltedTorus /. 
            Line[x_] :> {Thickness[0.01], Line[x]}, 
          tiltedCriticals}, disp, Boxed -> False, Axes -> False, 
        ViewPoint -> {0.101, -3.364, 0.346}];

Show[%, ViewPoint -> {0.101, -3.364, 0.346}, 
        Boxed -> False, Axes -> False];

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 Mathematica 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.

References

1. A. Gray  Modern Differential Geometry of Curves and Surfaces with Mathematica, CRC Press 1998
2. R. Cohen, J. Jones, G. Segal, Morse Theory and Classifying Spaces (preprint)
3. A. Kozlowski, A. Topology with Mathematica,  in preparation
4. J. Milnor Morse Theory, Princeton University Press, 1973
5. S. Smale On gradient dynamical systems, Annals of Mathematics, 74 (1961), 199-206
6. Y.Tazawa  Theory of Curves and Surfaces. An Introduction to Classical Differential Geometry by Mathematica (in Japanese),