This notebook contains additional material to the Mathematica GuideBooks  (Springer-Verlag, New York, 2004) http://www.MathematicaGuideBooks.org . It uses the stylesheet of the Mathematica GuideBooks, which is embedded.

Graphics Volume, Chapter 2

Construct and visualize a Klein bottle whose surface consists of a massive hexagonal framework.

ψ[{t_, φ_}] = 
Module[{spine2D = {Sin[t]^4, 2 (Sin[t] + Sin[2t]/3)},
        radius = 1/6 + 1/8 (Sin[2t]^2)^(1/4) (Pi/2 - t),
        𝒹1 = {0, 0, 1}, 𝓉, 𝒹2, spine3D},
        𝓉 = #/Sqrt[#.#]&[D[spine2D, t]];
        𝒹2 = Append[Reverse[𝓉] {-1, 1}, 0];
        spine3D = Append[spine2D, 0];
        spine3D + radius (Cos[φ] 𝒹1 + Sin[φ] 𝒹2)];

Next, we create the list of hexagons that we want to map onto the Klein bottle surface. The coordinates of the vertices of the hexagons cover the parametrization domain (0,π)×(0,2π). Some vertices slightly stick out of this domain to fit into the corresponding hole on the opposite edge of the parametrization domain.

hexagonCarpet = 
With[{(* number of hexagon rows and columns *) m = 17, n = 73,
      (* a unit hexagon *)
      hexagon = Line[Table[{Cos[p], Sin[p]}, {p, 0, 2Pi, 2Pi/6}]]},
      (* map hexagons into parametrization domain of the Klein bottle *)
      𝒻[{x_, y_}] = {2 Pi (x + 1)/(3(n + 1))/2, 
                     Pi (y + Cos[Pi/6])/(Cos[Pi/6](m + 1))};
     N[Map[𝒻, #, {3}], 30]& @
     (* array of hexagons *)
     Flatten[{Table[Map[# + {3i, j Cos[Pi/6]}&, hexagon, {2}], 
                     {i, 0, n}, {j, 0, 2 m, 2}],
              Table[Map[# + {3i + 3/2, j Cos[Pi/6]}&, hexagon, {2}], 
                    {i, 0, n}, {j, 1, 1 + 2m, 2}]}]];

With respect to the φ-parametrization, the sticking -out points map trivially into the corresponding holes. By the definition of a Klein bottle, this is not the case for the t-parametrization. We must account for the twist of (180^°) along the spine. The following 18 points have t-values greater than π.

wrapAroundPoints = Union[Cases[hexagonCarpet, {_?(# > Pi&), _}, {3}]];
Length[wrapAroundPoints]

We realize the twist in the Klein bottle by using the parametrization ψ({t mod π, φ}) and by stitching corresponding points appropriately together. The function ψStitched maps the hexagon edge Line[l] correctly on to the Klein bottle.

ψ1[{t_, φ_}] := If[t >= Pi, ψ[{t - Pi, φ}], ψ[{t, φ}]];
ψPs = ψ1 /@ wrapAroundPoints;

ψStitched[Line[l_]] :=
If[(* wrap around? *) Max[First /@ l] > Pi,
  Module[{mp, 𝕕},
   (* find point to connect to *)
   mp = (Plus @@ #/Length[#])&[ψ1 /@ Cases[Rest[l], {_?(# < Pi&), _}]];
   𝕕 = ψPs[[Position[#, Min[#]]&[#.#& /@ ((mp - #)& /@ ψPs)][[1, 1]]]];
   Line[MapAt[𝕕&, ψ /@ l, Position[l, {_?(# > Pi&), _}]]]],
   (* no wrap around *) Line[ψ1 /@ l]]

hexagonTiledKleinBottle is a list of polygons forming a Klein bottle made from hexagons.

hexagonTiledKleinBottle = Polygon @@@ (Map[ψStitched, hexagonCarpet] // N);

Here are two views on the resulting Klein bottle. The right graphic shows that the hexagons were correctly mapped at the transition t=π=>t-0.

Show[GraphicsArray[
Graphics3D[{EdgeForm[Thickness[0.0001]], hexagonTiledKleinBottle}, 
            Boxed -> False, ##]& @@@ {{}, {ViewPoint -> {0, -2, 0}}}]]

We continue by constructing a massive wireframe along the edges of the hexagons. Because the size of the hexagons varies across the Klein bottle surface, so should the thickness of the massive wireframe. To thicken the hexagon edges in the direction approximately normal to the surface, we find the neighboring three vertices and erect a normal on the plane formed by these three neighbors.

To find all three neighbors of a given vertex quickly, we extract all edges and sort them. Then we define the function neighbors for the 5328 vertices of the hexagons.

sortedEdgeList = (* extract and sort all edges *)
Union /@ Split[Sort[Flatten[{#, Reverse[#]}& /@ 
   Flatten[Partition[#[[1]], 2, 1]& /@ hexagonTiledKleinBottle, 1], 1]],
                                 #1[[1]] === #2[[1]]&];
                                 
(neighbors[#[[1, 1]]] = Last /@ #)& /@ sortedEdgeList;
allVertices = #[[1, 1, 1]]& /@ DownValues[neighbors];

Given a vertex and its three neighbors, the function makeTetradNormal gives the normal of the plane formed by the three neighbors.

makeTetradNormal[q_, {p1_, p2_, p3_}] := 
Module[{𝓃 = #/Sqrt[#.#]&, d1, d2, v},
       (* remove components in plane {p1, p2, p3} *)
       d1 = 𝓃[p2 - p1]; d2 = 𝓃[p3 - p1]; d2 = 𝓃[d2 - d2.d1 d1];
       v = q - p1; 𝓃[v - v.d1 d1 - v.d2 d2]]

The function theNormal gives the normal for a given vertex.

(theNormal[#] = makeTetradNormal[#, neighbors[#]])& /@ allVertices;

Now, we have all functions together to implement the function make3DBorder that for a given hexagon forms the 2×2×6 polygons forming the massive wireframe. To guarantee that the polygons fit together appropriately, we make sure that the orientation is uniform and determine the thickness of the massive wireframe from the average distance to the three neighbor vertices.

make3DBorder[Polygon[l_], α_, β_] := 
Module[{𝓃 = #/Sqrt[#.#]&, mp = Plus @@ Rest[l]/6,
        hexagonNormal, λs, pointNormals, L, ℓ, ℒ},
 (* the averaged normal of the hexagon *)
 hexagonNormal  = 𝓃[Plus @@ (𝓃[Cross[#1 - mp, #2 - mp]]& @@@ 
                                             Partition[l, 2, 1])/6];
(* average hexagon edge length/2 *)
 λs  = (Function[p, Plus @@ (Sqrt[#.#& @ (p - #)]& /@ 
                                           neighbors[p])] /@ l)/12;                              
 (* normals at the vertices *)
 pointNormals = If[hexagonNormal.# < 0, -#, #]& /@ (theNormal /@ l);
(* contracted hexagon *)
 ℓ = (mp + α (# - mp))& /@ l;   
 Table[(* move out of hexagon plane in normal directions *)
       {L, ℒ} = (# + sign β λs pointNormals)& /@ {l, ℓ};
       (* form polygons of beams *)
       MapThread[Polygon[Join[#1, Reverse[#2]]]&, 
                 {Partition[#1, 2, 1],  Partition[#2, 2, 1]}]& @@@
                                                  {{L, ℒ}, {ℓ, ℒ}}, 
       (* up and down *) {sign, -1, 1, 2}]]

Here are three original hexagons and the polygons forming the wireframe.

Module[{vertex = hexagonTiledKleinBottle[[100, 1, 1]],
        threeNeighborHexagons},
(* the polygons sharing vertex *)
threeNeighborHexagons = hexagonTiledKleinBottle[[
     Union[First /@ Position[hexagonTiledKleinBottle, vertex]]]];
(* original hexagons in red, wireframe polygons in yellow *)
Show[Graphics3D[
{{SurfaceColor[Hue[0], Hue[0], 2.1], threeNeighborHexagons},
 {SurfaceColor[Hue[0.12], Hue[0.12], 2.1], 
  make3DBorder[#, 0.8, 0.8]& /@ threeNeighborHexagons}}]]]

The list KleinBottlePolys contains the 63936 polygons forming the massive hexagonal framework wireframe.

KleinBottlePolys = make3DBorder[#, 0.86, 0.6]& /@ hexagonTiledKleinBottle;

Here are views of the resulting Klein bottle and its cross section.

Show[GraphicsArray[
Graphics3D[{EdgeForm[], SurfaceColor[Hue[0.18], Hue[0.03], 1.3], 
            KleinBottlePolys},
           ViewPoint -> {3/2, 2, 3}, ViewVertical -> {0, 1, 0}, 
           Boxed -> False, ##]& @@@ 
                    (* show all and cross section *)
                    {{}, {PlotRange -> {All, All, {0, -0.3}}}}]]