(************** 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[ 23745, 624]*) (*NotebookOutlinePosition[ 24423, 647]*) (* CellTagsIndexPosition[ 24379, 643]*) (*WindowFrame->Normal*) Notebook[{ Cell[BoxData[{ \(Off[General::spell]; \ Off[General::spell1];\ \), "\[IndentingNewLine]", \(\(Off[Solve::ifun];\)\), "\n", \(\(Off[Reduce::ifun];\)\), "\[IndentingNewLine]", \(\(Needs["\"];\)\), "\n", \(\(Needs["\"];\)\), "\[IndentingNewLine]", \(disp := DisplayFunction -> $DisplayFunction\)}], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(AxesOnSurface[ eq_] := \[IndentingNewLine]Module[{\[Phi]axis = Insert[ParametricPlot3D[ Evaluate[ Append[eq[0, \[Phi]], RGBColor[0, 1, 0]]], {\[Phi], \(-Pi\), \ \[Pi]}, Lighting \[Rule] False, PlotPoints \[Rule] 40, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity], Thickness[0.015], {1, 1}], \[Theta]axis = Insert[ParametricPlot3D[ Evaluate[ Append[eq[\[Theta], 0], RGBColor[1, 0, 0]]], {\[Theta], \(-Pi\), \ \[Pi]}, Lighting \[Rule] False, PlotPoints \[Rule] 40, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity], Thickness[0.015], {1, 1}]}, Show[{\[Phi]axis, \[Theta]axis}, DisplayFunction \[Rule] Identity]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(tor[\[Theta]_, \[Phi]_] := {\((Cos[\[Theta]] + 4)\)\ Cos[\[Phi]], Sin[\[Theta]], \((Cos[\[Theta]] + 4)\)\ Sin[\[Phi]]}\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(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",\ CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(height[\[Theta]_, \[Phi]_] := \(tor[\[Theta], \[Phi]]\)\ \[LeftDoubleBracket]3\[RightDoubleBracket]\)], "Input", CellFrame->True, TextAlignment->Left, TextJustification->0, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(\(T[\[Alpha]_, \[Beta]_]\)[\[Theta]_, \[Phi]_] := {\[Alpha] + \ \[Theta], \[Beta] + \[Phi]};\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(trans = Apply[T, Distribute[{{\[Pi]\/2, \(-\(\[Pi]\/2\)\)}, {\[Pi]\/2, \(-\(\[Pi]\/2\ \)\)}}, List], {1}];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(\(height[i_]\)[\[Theta]_, \[Phi]_] := height @@ \(trans\[LeftDoubleBracket] i\[RightDoubleBracket]\)[\[Theta], \[Phi]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(gradient[f_, {\[Theta]__}] := Through[\(Through[\(Apply[Derivative, IdentityMatrix[Length[{\[Theta]}]], {1}]\)[ f]]\)[\[Theta]]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(solrules := DeleteCases[\((Solve[ gradient[height[#1], {\[Theta], \[Phi]}] == 0, {\[Theta], \[Phi]}] &)\) /@ Range[4], {\[Phi] \[Rule] x_, \[Theta] \[Rule] y_} /; \(! \((Im[x] == 0 && Im[y] == 0)\)\), \[Infinity]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(TorusAndAxes := Show[torus[], AxesOnSurface[tor]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(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", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(Hessian[f_, {x__}] := Flatten[Outer[D, {f}, {x}, {x}], 1]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(index[f_, x_List, a_List] := Count[Eigenvalues[ Hessian[f, x] /. \[InvisibleSpace]Thread[x \[Rule] a]], _? Negative]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(MorsePolynomial[indices_List, t_] := \[Sum]\+\(i = Min[indices]\)\%\(Max[indices]\)Count[indices, i]\ t\^i\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(PiecewiseFlow3D[eq_, height_, l_List, t_List, color_: RGBColor[1, 0, 0]] := Module[{sols = {}, sol, solrules, s, \[Theta], \[Phi]}, Fold[\((AppendTo[ sols, {Join @@ \((solrules = NDSolve[ Join[Thread[{\(\[Theta]'\)[s], \(\[Phi]'\)[ s]} \[Equal] \(-gradient[ height, {\[Theta][s], \[Phi][ s]}]\)], {\[Theta][ 0] \[Equal] #1[\([1]\)], \[Phi][ 0] \[Equal] #1[\([2]\)]}], {\[Theta], \ \[Phi]}, {s, 0, #2}])\), {s, 0, #2}}]; Flatten[\(({\[Theta][s], \[Phi][s]} /. solrules)\)] /. s \[Rule] #2)\) &, l, t]; With[{f = \(eq[\[Theta][s], \[Phi][s]]\)[\([1]\)], g = \(eq[\[Theta][s], \[Phi][s]]\)[\([2]\)], h = \(eq[\[Theta][s], \[Phi][ s]]\)[\([3]\)]}, \(\(ParametricPlot3D[##, DisplayFunction \[Rule] Identity] &\) @@ {{f, g, h, color} /. #[\([1]\)], #[\([2]\)]} &\) /@ Evaluate[sols]]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(LevelPoints[height_, value_, {l1_, l2_, l3_, l4_}, pts_] := \(Graphics[ ImplicitPlot[ Evaluate[height[a, b] \[Equal] value], {a, l1, l2}, {b, l3, l4}, DisplayFunction \[Rule] Identity, PlotPoints \[Rule] pts]]\)[\([1, 1, 3, 1]\)]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(LevelPoints[height_, value_] := \(Graphics[ ImplicitPlot[ Evaluate[height[a, b] \[Equal] value], {a, \(-Pi\), Pi}, {b, \(-Pi\), Pi}, DisplayFunction \[Rule] Identity, PlotPoints \[Rule] 90]]\)[\([1, 1, 3, 1]\)]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \( (*LevelCurve[eq_, height_, val_] := Module[{p = LevelPoints[height, val], q, r}, q = p /. {x_?NumberQ, y_?NumberQ} \[Rule] {x, Pi - y}; r = Join[p, q]; \[IndentingNewLine]Map[ Graphics3D[{PointSize[0.02], Point[#]}] &, \((eq @@@ r)\)]]*) \)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(LevelCurve[eq_, height_, val_] := Show[Graphics3D[\({RGBColor[1, 0, 0], Thickness[0.02], Line[#]} &\)@\((eq @@@ LevelPoints[height, val])\)], DisplayFunction \[Rule] Identity]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(LevelCurvesOnTorus := Module[{values = {4.8, 2.8, \(-2.9\), \(-3.5\)}, p, q, r}, \[IndentingNewLine]p = Flatten[Map[LevelPoints[height, #] &, values], 1]; q = p /. {x_?NumberQ, y_?NumberQ} \[Rule] {x, Pi - y}; r = Join[p, q]; \[IndentingNewLine]Show[{Graphics3D[ Map[{PointSize[0.02], Point[#]} &, tor @@@ r]], torus[]}, DisplayFunction \[Rule] Identity]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(SpecialFlowsOnTorus := With[{startpoints = Take[solutions, {1, 3}]}, \(PiecewiseFlow3D[tor, height, #, {1, 1, 1, 1, 1}, RGBColor[0, 1, 0]] &\) /@ N[Join[\((Transpose[Take[startpoints, {2, 3}]] + {0, 1/10})\) // Transpose, \((Transpose[ Take[startpoints, {2, 3}]] + {0, \(-1\)/10})\) // Transpose, \((Transpose[startpoints] + {1/10, 0})\) // Transpose, \((Transpose[startpoints] + {\(-1\)/10, 0})\) // Transpose]]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(FlowsOnTorus1 := With[{values = {4.8, 2.8, \(-2.9\), \(-3.5\)}}, \ \[IndentingNewLine]Show[{\(PiecewiseFlow3D[tor, height, #, {1, 1, 1}] &\) /@ Flatten[Map[ LevelPoints[height, #, {\(-Pi\), 0, \(-Pi\)/2, Pi/2}, 13] &, values], 1]}]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(FlowsOnTorus2 := Module[{w = FlowsOnTorus1, u, v, p}, \[IndentingNewLine]u = w /. Line[{{a_, b_, c_}, {d_, e_, f_}}] \[Rule] Line[{{a, \(-b\), c}, {d, \(-e\), f}}]; v = w /. Line[{{a_, b_, c_}, {d_, e_, f_}}] \[Rule] Line[{{\(-a\), b, c}, {\(-d\), e, f}}]; p = u /. Line[{{a_, b_, c_}, {d_, e_, f_}}] \[Rule] Line[{{\(-a\), b, c}, {\(-d\), e, f}}]; Show[{w, u, v, p}, DisplayFunction \[Rule] Identity]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(FlowsOnTorus := Show[{torus[], FlowsOnTorus2, SpecialFlowsOnTorus /. Line[x_] \[RuleDelayed] {Thickness[0.01], Line[x]}}]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(th = Pi/6;\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(Rt = FunctionExpand[{{1, 0, 0}, {0, Cos[th], Sin[th]}, {0, \(-Sin[th]\), Cos[th]}}];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedTor[\[Theta]_, \[Phi]_] := Flatten[Rt . Transpose[{tor[\[Theta], \[Phi]]}]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(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",\ CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(tiltedHeight[\[Theta]_, \[Phi]_] := \(tiltedTor[\[Theta], \[Phi]]\)\ \[LeftDoubleBracket]3\[RightDoubleBracket]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(\(tiltedHeight[i_]\)[\[Theta]_, \[Phi]_] := tiltedHeight @@ \(trans\[LeftDoubleBracket] i\[RightDoubleBracket]\)[\[Theta], \[Phi]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedSolrules := DeleteCases[\((Solve[ gradient[tiltedHeight[#1], {\[Theta], \[Phi]}] == 0, {\[Theta], \[Phi]}] &)\) /@ Range[4], {\[Phi] \[Rule] x_, \[Theta] \[Rule] y_} /; \(! \((Im[x] == 0 && Im[y] == 0)\)\), \[Infinity]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedSolutions := N[Sort[Union[ Select[Flatten[\((Apply[#1, {\[Theta], \[Phi]} /. tiltedSolrules[\([1]\)], {1}] &)\) /@ trans, 1], gradient[tiltedHeight, #] \[Equal] {0, 0} &], SameTest \[Rule] \((Simplify[tiltedTor @@ #1] \[Equal] Simplify[tiltedTor @@ #2] &)\)], tiltedHeight @@ #1 > tiltedHeight @@ #2 &]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedColors := Join[Table[RGBColor[1, 0, 0], {1}], Table[RGBColor[1, 1, 0], {2}], Table[RGBColor[0, 0, 1], {1}]];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedCoords := tiltedTor @@@ N[tiltedSolutions] // Chop;\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedColoredCoords := Transpose[{tiltedColors, tiltedCoords}];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(tiltedCriticals := Graphics3D[\({#1, PointSize[0.04], Point[N[#2]]} &\) @@@ tiltedColoredCoords];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(SpecialFlowsOnTiltedTorus := With[{startpoints = {{\(-0.42359877559829884`\), 1.5707963267948966`}, {\(-0.6235987755982988`\), 1.5707963267948966`}, {2.4764012244017013`, 1.5807963267948966`}, {2.4764012244017013`, 1.5607963267948965`}, {\(-2.7179938779914945`\), \ \(-1.5707963267948966`\)}, {\(-2.5179938779914943`\), \ \(-1.5707963267948966`\)}, {\(-1.3764012244017012`\), 1.5907963267948966`}, {\(-1.3764012244017012`\), 1.5507963267948965`}}}, \(PiecewiseFlow3D[tiltedTor, tiltedHeight, #, {1, 1, 1, 1, 1}, RGBColor[0, 1, 0]] &\) /@ startpoints]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(FlowsOnTiltedTorus1 := With[{values = {4.3, 2.3, \(-2.5\)}}, \[IndentingNewLine]Show[{\(PiecewiseFlow3D[ tiltedTor, tiltedHeight, #, {1, 1, 1}] &\) /@ Flatten[Map[ LevelPoints[tiltedHeight, #, N[{\(-Pi\), Pi, \(-Pi\)/2, Pi/2}], 40] &, values], 1]}]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(FlowsOnTiltedTorus2 := With[{w = FlowsOnTiltedTorus1}, Show[{w, w /. Line[{{a_, b_, c_}, {d_, e_, f_}}] \[Rule] Line[{{\(-a\), b, c}, {\(-d\), e, f}}]}, PlotRange \[Rule] All, DisplayFunction \[Rule] Identity]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(FlowsOnTiltedTorus := Show[{tiltedTorus[], FlowsOnTiltedTorus2, SpecialFlowsOnTiltedTorus /. Line[x_] \[RuleDelayed] {Thickness[0.01], Line[x]}}]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[{ \(\(vertices[s_] := Union[Flatten[Cases[s, Polygon[l_] \[RuleDelayed] l, Infinity], 1]]\ ;\)\), "\n", \(\(SetAttributes[Side, Orderless];\)\), "\n", \(\(sides[s_] := Union[Cases[ s /. Polygon[l_] :> Side @@@ Partition[Append[l, First[l]], 2, 1], _Side, Infinity]];\)\), "\n", \(\(faces[s_] := Cases[s, _Polygon, Infinity];\)\), "\n", \(NumberOfVertices[s_] := Length[vertices[s]]; NumberOfSides[s_] := Length[sides[s]];\), "\n", \(\(NumberOfFaces[s_] := Length[faces[s]];\)\), "\n", \(\(EulerCharacteristic[s_] := NumberOfVertices[s] - NumberOfSides[s] + NumberOfFaces[s];\)\), "\n", \(\(star[v_, gr_] := Cases[gr, Polygon[{l___, v, m___}], Infinity];\)\), "\n", \(\(link[v_, gr_] := Union[Cases[ star[v, gr] /. Polygon[l_] \[RuleDelayed] Line /@ Partition[Append[l, First[l]], 2, 1], _?\((\((Head[#] === Line)\) && \((FreeQ[#, v])\) &)\), Infinity]];\)\), "\n", \(\(star[v_Side, tr_] := Cases[tr, Polygon[l_] /; MemberQ[Side @@@ Partition[Append[l, First[l]], 2, 1], v], Infinity];\)\), "\n", \(boundary[tr_] := Select[sides[tr], Length[star[#, tr]] \[Equal] 1 &] /. Side[l__] \[RuleDelayed] Line[{l}]\), "\n", \(\(OrderedUnion[l_List] := Block[{i}, i[n_] := \((i[n] = Sequence[]; n)\); \ i /@ l];\)\), "\n", \(\(closeup[k_, epsilon_: 10^\(-4\)] := k /. Polygon[l_] :> Polygon[N[OrderedUnion[Rationalize[l, epsilon]]]];\)\)}], "Input",\ CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(sphereloop[t_] := ParametricPlot3D[Evaluate[sp[u, t]], {u, 0, 2 Pi}, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(torusloop[s_] := Insert[ParametricPlot3D[ Evaluate[ Append[tor[\[Theta], s], RGBColor[1, 0, 0]]], {\[Theta], \(-Pi\), \ \[Pi]}, Lighting \[Rule] False, PlotPoints \[Rule] 40, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity], Thickness[0.02], {1, 1}]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(TranslateShape[shape_, vec_List] := Block[{tvec = N[vec]}, shape /. {poly : Polygon[_] \[RuleDelayed] Map[\((tvec + #)\) &, poly, {2}], line : Line[_] \[RuleDelayed] Map[\((tvec + #)\) &, line, {2}], point : Point[_] \[RuleDelayed] Map[\((tvec + #)\) &, point, {1}]}] /; Length[vec] \[Equal] 3\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(plane[v_] := TranslateShape[ ParametricPlot3D[{2 \((1 - v)\)*Cos[t], 2 v*Sin[t], s}, {t, \(-Pi\)/2, Pi/2}, {s, \(-1\), 1}, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity], {\(-1\) + 2\ v, 0, 0}]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(sp[u_, v_] := {Cos[u]\ Cos[v], Sin[u]\ Cos[v], Sin[v]}\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(sphere[p_: 25] := ParametricPlot3D[ Evaluate[sp[u, v]], {u, 0, 2 Pi}, {v, \(-Pi\)/2, Pi/2}, \ PlotPoints \[Rule] p, Boxed \[Rule] False, Axes \[Rule] False, DisplayFunction \[Rule] Identity];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(cyl[pts_: Automatic] := With[{c1 = ParametricPlot3D[{r\ Cos[\[Theta]], r\ Sin[\[Theta]], 0}, {r, 0, 1}, {\[Theta], 0, 2 Pi}, PlotPoints -> pts, DisplayFunction \[Rule] Identity], c2 = ParametricPlot3D[{r\ Cos[\[Theta]], r\ Sin[\[Theta]], 1}, {r, 0, 1}, {\[Theta], 0, 2 Pi}, PlotPoints -> pts, DisplayFunction \[Rule] Identity], c3 = ParametricPlot3D[{Cos[\[Theta]], Sin[\[Theta]], t}, {\[Theta], 0, 2 Pi}, {t, 0, 1}, PlotPoints -> pts, DisplayFunction \[Rule] Identity]}, \[IndentingNewLine]Show[{c1, c2, c3}, Boxed \[Rule] False, Axes \[Rule] False]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(klein[\[Theta]_, \[Phi]_] := {\((2 + Cos[\[Phi]/2]\ Sin[\[Theta]] - Sin[\[Phi]/2]\ Sin[2 \[Theta]])\)\ Cos[\[Phi]], \((2 + Cos[\[Phi]/2]\ Sin[\[Theta]] - Sin[\[Phi]/2]\ Sin[2 \[Theta]])\)\ Sin[\[Phi]], Sin[\[Phi]/2]\ Sin[\[Theta]] + Cos[\[Phi]/2]\ Sin[2 \[Theta]]};\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(kleinBottle[a_: - Pi, b_: Pi, c_: - Pi, d_: Pi, plotpoints_: 25] := ParametricPlot3D[ Evaluate[klein[\[Theta], \[Phi]]], {\[Phi], c, d}, {\[Theta], a, b}, PlotPoints \[Rule] plotpoints, Boxed \[Rule] False, Axes \[Rule] None, Lighting \[Rule] True, DisplayFunction \[Rule] Identity];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(rectangle := Show[Graphics[{RGBColor[1, 0, 0], Line[{{\(-\[Pi]\), \(-\[Pi]\)}, {\[Pi], \(-\[Pi]\)}}], RGBColor[0, 1, 0], Line[{{\[Pi], \(-\[Pi]\)}, {\[Pi], \[Pi]}}], RGBColor[1, 0, 0], Line[{{\[Pi], \[Pi]}, {\(-\[Pi]\), \[Pi]}}], RGBColor[0, 1, 0], Line[{{\(-\[Pi]\), \[Pi]}, {\(-\[Pi]\), \(-\[Pi]\)}}]}], Axes \[Rule] True, AspectRatio \[Rule] Automatic, AxesLabel \[Rule] {\[Theta], \[Phi]}, DisplayFunction \[Rule] Identity];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(\(smallrectangle := Graphics[{RGBColor[0, 0, 1], Line[{{\(-\[Pi]\)/2, \(-\[Pi]\)/2}, {\[Pi]/2, \(-\[Pi]\)/2}}], Line[{{\[Pi]/2, \(-\[Pi]\)/2}, {\[Pi]/2, \[Pi]/2}}], Line[{{\[Pi]/2, \[Pi]/2}, {\(-\[Pi]\)/2, \[Pi]/2}}], Line[{{\(-\[Pi]\)/2, \[Pi]/2}, {\(-\[Pi]\)/2, \(-\[Pi]\)/ 2}}]}];\)\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]], Cell[BoxData[ \(patches := With[{t1 = Insert[torus[\(-Pi\) - 0.1, 0.1, \(-Pi\) - 0.1, 0.1], RGBColor[1, 0, 0], {1, 1}], \n t2 = Insert[torus[\(-Pi\) - 0.1, 0.1, \(-0.1\), Pi + 0.1], RGBColor[0, 0, 1], {1, 1}], \n t3 = Insert[torus[\(-0.1\), Pi + 0.1, \(-Pi\) - 0.1, 0.1], RGBColor[0, 1, 0], {1, 1}], \n t4 = Insert[torus[\(-0.1\), Pi + 0.1, \(-0.1\), Pi + 0.1], RGBColor[1, 1, 0], {1, 1}]}, \n Show[{t1, t2, t3, t4}, Lighting \[Rule] False]]\)], "Input", CellFrame->True, Background->GrayLevel[0.849989]] }, FrontEndVersion->"4.1 for Macintosh", ScreenRectangle->{{0, 1152}, {0, 746}}, WindowToolbars->{"RulerBar", "EditBar"}, WindowSize->{520, 661}, WindowMargins->{{45, Automatic}, {Automatic, 16}} ] (******************************************************************* 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[1705, 50, 443, 9, 123, "Input"], Cell[2151, 61, 1045, 22, 299, "Input"], Cell[3199, 85, 214, 4, 59, "Input"], Cell[3416, 91, 427, 9, 107, "Input"], Cell[3846, 102, 233, 6, 43, "Input"], Cell[4082, 110, 183, 4, 43, "Input"], Cell[4268, 116, 217, 6, 74, "Input"], Cell[4488, 124, 233, 5, 43, "Input"], Cell[4724, 131, 253, 6, 107, "Input"], Cell[4980, 139, 402, 9, 107, "Input"], Cell[5385, 150, 136, 3, 43, "Input"], Cell[5524, 155, 401, 9, 108, "Input"], Cell[5928, 166, 144, 3, 43, "Input"], Cell[6075, 171, 230, 6, 75, "Input"], Cell[6308, 179, 215, 5, 89, "Input"], Cell[6526, 186, 1282, 24, 315, "Input"], Cell[7811, 212, 373, 8, 123, "Input"], Cell[8187, 222, 356, 8, 107, "Input"], Cell[8546, 232, 386, 8, 123, "Input"], Cell[8935, 242, 295, 6, 123, "Input"], Cell[9233, 250, 527, 11, 171, "Input"], Cell[9763, 263, 636, 12, 235, "Input"], Cell[10402, 277, 397, 9, 123, "Input"], Cell[10802, 288, 579, 11, 155, "Input"], Cell[11384, 301, 239, 6, 91, "Input"], Cell[11626, 309, 101, 3, 43, "Input"], Cell[11730, 314, 199, 5, 75, "Input"], Cell[11932, 321, 182, 4, 43, "Input"], Cell[12117, 327, 384, 8, 107, "Input"], Cell[12504, 337, 198, 4, 43, "Input"], Cell[12705, 343, 245, 5, 59, "Input"], Cell[12953, 350, 414, 9, 107, "Input"], Cell[13370, 361, 521, 10, 235, "Input"], Cell[13894, 373, 225, 5, 75, "Input"], Cell[14122, 380, 157, 4, 43, "Input"], Cell[14282, 386, 163, 4, 59, "Input"], Cell[14448, 392, 210, 5, 75, "Input"], Cell[14661, 399, 772, 14, 235, "Input"], Cell[15436, 415, 449, 10, 171, "Input"], Cell[15888, 427, 365, 9, 123, "Input"], Cell[16256, 438, 263, 6, 91, "Input"], Cell[16522, 446, 1780, 42, 651, "Input"], Cell[18305, 490, 267, 6, 75, "Input"], Cell[18575, 498, 437, 10, 139, "Input"], Cell[19015, 510, 471, 10, 139, "Input"], Cell[19489, 522, 370, 9, 123, "Input"], Cell[19862, 533, 141, 3, 43, "Input"], Cell[20006, 538, 325, 7, 91, "Input"], Cell[20334, 547, 808, 15, 219, "Input"], Cell[21145, 564, 434, 8, 91, "Input"], Cell[21582, 574, 431, 8, 123, "Input"], Cell[22016, 584, 636, 12, 155, "Input"], Cell[22655, 598, 453, 9, 123, "Input"], Cell[23111, 609, 630, 13, 203, "Input"] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)