(* 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[ 28790, 850] NotebookOptionsPosition[ 27691, 811] NotebookOutlinePosition[ 28035, 826] CellTagsIndexPosition[ 27992, 823] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Milnor Fibrations for ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["z", "m"], "-", " ", SuperscriptBox["w", "n"]}], TraditionalForm]], "None", FormatType->"TraditionalForm"] }], "Title", CellChangeTimes->{{3.485530733643811*^9, 3.485530738653818*^9}, { 3.4855308417235785`*^9, 3.4855308856536407`*^9}}], Cell["\<\ Author: Dan Dreibelbis University of North Florida ddreibel@unf.edu www.unf.edu/~ddreibel Last Modified: 6/14/2010 \ \>", "Section", CellChangeTimes->{{3.4855309281036997`*^9, 3.48553098546378*^9}}], Cell[CellGroupData[{ Cell["\<\ Code (Click to the right to expand.) \ \>", "Section", CellChangeTimes->{{3.4855310274638386`*^9, 3.485531158204022*^9}}], Cell[TextData[{ StyleBox["\nThe following programs are contained in this section:\n\n", FontSize->16], StyleBox["InitFiber[m, n] - ", FontSize->16, FontWeight->"Bold"], StyleBox["This program takes in two positive integers ", FontSize->16], StyleBox["m", FontSize->16, FontSlant->"Italic"], StyleBox[" and ", FontSize->16], StyleBox["n", FontSize->16, FontSlant->"Italic"], StyleBox[" and sets three values as defined below:\n\n\t", FontSize->16], StyleBox["milnorf", FontSize->16, FontWeight->"Bold"], StyleBox[" - This is the real portion of ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["z", "m"], "-", " ", SuperscriptBox["w", "n"]}], TraditionalForm]], "None", FontSize->16], StyleBox[", intersected with the hypersphere of radius ", FontSize->16], Cell[BoxData[ FormBox[ SqrtBox["2"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[" in ", FontSize->16], Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "4"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[", then stereographically projected into ", FontSize->16], Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[" from the point ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{ SqrtBox["2"], ",", " ", "0", ",", " ", "0", ",", " ", "0"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[". \n\t", FontSize->16], StyleBox["milnorg", FontSize->16, FontWeight->"Bold"], StyleBox[" - This is the imaginary portion of ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["z", "m"], "-", " ", SuperscriptBox["w", "n"]}], TraditionalForm]], "None", FontSize->16], StyleBox[", intersected with the hypersphere of radius ", FontSize->16], Cell[BoxData[ FormBox[ SqrtBox["2"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[" in ", FontSize->16], Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "4"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[", then stereographically projected into ", FontSize->16], Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[" from the point ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{ SqrtBox["2"], ",", " ", "0", ",", " ", "0", ",", " ", "0"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[". \n\t", FontSize->16], StyleBox["milnorlink - ", FontSize->16, FontWeight->"Bold"], StyleBox["This is a drawing of the the link of ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["z", "m"], "-", " ", SuperscriptBox["w", "n"]}], TraditionalForm]], FontSize->16], StyleBox[". We get the link by intersecting ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SuperscriptBox["z", "m"], "-", " ", SuperscriptBox["w", "n"]}], "=", "0"}], TraditionalForm]], FontSize->16], StyleBox[" with the hypersphere of radius ", FontSize->16], Cell[BoxData[ FormBox[ SqrtBox["2"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[" in ", FontSize->16], Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "4"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[", then stereographically projected into ", FontSize->16], Cell[BoxData[ FormBox[ SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[" from the point ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{ SqrtBox["2"], ",", " ", "0", ",", " ", "0", ",", " ", "0"}], ")"}], TraditionalForm]], FormatType->"TraditionalForm", FontSize->16], StyleBox[". \n\n", FontSize->16], StyleBox["DrawFiber[th, op1, op2] ", FontSize->16, FontWeight->"Bold"], StyleBox["- This returns the double fiber milnorf Cos[th] + milnorg Sin[th], \ along with the link milnorlink. One of the fibers is colored green, the \ other fiber is colored orange. The options ", FontSize->16], StyleBox["op1", FontSize->16, FontWeight->"Bold"], StyleBox[" and ", FontSize->16], StyleBox["op2", FontSize->16, FontWeight->"Bold"], StyleBox[" control the opacity of each fiber, and they should range between \ 0 and 1. To see a single fiber, set ", FontSize->16], StyleBox["op1 = 0", FontSize->16, FontWeight->"Bold"], StyleBox[" and ", FontSize->16], StyleBox["op1 = 1", FontSize->16, FontWeight->"Bold"], StyleBox[", or vice versa.\n\n", FontSize->16], StyleBox["MyTube[curve, radius] ", FontSize->16, FontWeight->"Bold"], StyleBox["- Takes a curve ", FontSize->16], StyleBox["curve", FontSize->16, FontWeight->"Bold"], StyleBox[" and returns a tube of radius ", FontSize->16], StyleBox["radius", FontSize->16, FontWeight->"Bold"], StyleBox[". This is used to create ", FontSize->16], StyleBox["milnorlink", FontSize->16, FontWeight->"Bold"], StyleBox[".", FontSize->16], "\n\n" }], "Text", CellChangeTimes->{{3.485531166714034*^9, 3.4855315136745195`*^9}, { 3.485531548464568*^9, 3.485531889655046*^9}, {3.48553192125509*^9, 3.485532070225299*^9}, {3.485532105295348*^9, 3.4855321057653484`*^9}, 3.485532170048509*^9}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"InitFiber", "[", RowBox[{"m_", ",", " ", "n_"}], "]"}], " ", ":=", " ", RowBox[{"Block", "[", RowBox[{ RowBox[{"{", RowBox[{ "ff", ",", " ", "u", ",", " ", "v", ",", " ", "x", ",", " ", "y", ",", " ", "z", ",", " ", "w", ",", " ", "gg", ",", " ", "curves", ",", " ", "tubes"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"ff", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"u", "^", "m"}], " ", "-", " ", RowBox[{"v", "^", "n"}]}], " ", "/.", " ", RowBox[{"{", RowBox[{ RowBox[{"u", "\[Rule]", RowBox[{"x", " ", "+", " ", RowBox[{"I", " ", "y"}]}]}], ",", " ", RowBox[{"v", " ", "\[Rule]", " ", RowBox[{"z", " ", "+", " ", RowBox[{"w", " ", "I"}]}]}]}], "}"}]}]}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"milnorf", ",", " ", "milnorg"}], "}"}], " ", "=", " ", RowBox[{ RowBox[{"Factor", "[", RowBox[{"(", RowBox[{ RowBox[{"ComplexExpand", "[", RowBox[{"{", RowBox[{ RowBox[{"Re", "[", "ff", "]"}], ",", " ", RowBox[{"Im", "[", "ff", "]"}]}], "}"}], "]"}], " ", "/.", " ", RowBox[{"{", RowBox[{ RowBox[{"x", "->", FractionBox[ RowBox[{ SqrtBox["2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "2"}], "+", SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"], "+", SuperscriptBox["z", "2"]}], ")"}]}], RowBox[{"2", "+", SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"], "+", SuperscriptBox["z", "2"]}]]}], ",", RowBox[{"y", "->", FractionBox[ RowBox[{"4", " ", "x"}], RowBox[{"2", "+", SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"], "+", SuperscriptBox["z", "2"]}]]}], ",", RowBox[{"z", "->", FractionBox[ RowBox[{"4", " ", "y"}], RowBox[{"2", "+", SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"], "+", SuperscriptBox["z", "2"]}]]}], ",", RowBox[{"w", "->", FractionBox[ RowBox[{"4", " ", "z"}], RowBox[{"2", "+", SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"], "+", SuperscriptBox["z", "2"]}]]}]}], "}"}]}], ")"}], "]"}], " ", "*", " ", RowBox[{ RowBox[{"(", RowBox[{"2", "+", RowBox[{"x", "^", "2"}], "+", RowBox[{"y", "^", "2"}], "+", RowBox[{"z", "^", "2"}]}], ")"}], "^", RowBox[{"Max", "[", RowBox[{"m", ",", "n"}], "]"}]}]}]}], ";", "\[IndentingNewLine]", RowBox[{"curves", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", FractionBox[ RowBox[{ RowBox[{"Sqrt", "[", "2", "]"}], " ", "y"}], RowBox[{ RowBox[{"-", RowBox[{"Sqrt", "[", "2", "]"}]}], "+", "x"}]]}], ",", RowBox[{"-", FractionBox[ RowBox[{ RowBox[{"Sqrt", "[", "2", "]"}], " ", "z"}], RowBox[{ RowBox[{"-", RowBox[{"Sqrt", "[", "2", "]"}]}], "+", "x"}]]}], ",", RowBox[{"-", FractionBox[ RowBox[{ RowBox[{"Sqrt", "[", "2", "]"}], " ", "w"}], RowBox[{ RowBox[{"-", RowBox[{"Sqrt", "[", "2", "]"}]}], "+", "x"}]]}]}], "}"}], " ", " ", "/.", " ", RowBox[{"{", RowBox[{ RowBox[{"x", "->", RowBox[{"Cos", "[", RowBox[{ RowBox[{"n", " ", "u"}], "+", RowBox[{"2", " ", "Pi", " ", RowBox[{"k", "/", "m"}]}]}], "]"}]}], ",", RowBox[{"y", "->", RowBox[{"Sin", "[", RowBox[{ RowBox[{"n", " ", "u"}], "+", RowBox[{"2", " ", "Pi", " ", RowBox[{"k", "/", "m"}]}]}], "]"}]}], ",", RowBox[{"z", "->", RowBox[{"Cos", "[", RowBox[{"m", " ", "u"}], "]"}]}], ",", RowBox[{"w", "->", RowBox[{"Sin", "[", RowBox[{"m", " ", "u"}], "]"}]}]}], "}"}]}], ",", " ", RowBox[{"{", RowBox[{"k", ",", " ", "0", ",", " ", RowBox[{ RowBox[{"GCD", "[", RowBox[{"m", ",", " ", "n"}], "]"}], "-", "1"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"tubes", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"MyTube", "[", RowBox[{ RowBox[{"curves", "[", RowBox[{"[", "i", "]"}], "]"}], ",", " ", ".1"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", RowBox[{"Length", "[", "curves", "]"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"milnorlink", " ", "=", " ", RowBox[{"Show", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"tubes", "[", RowBox[{"[", "i", "]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"u", ",", " ", "0", " ", ",", " ", RowBox[{"2", " ", "Pi"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"v", ",", " ", "0", ",", " ", RowBox[{"2", " ", "Pi"}]}], "}"}], ",", " ", RowBox[{"PlotPoints", "\[Rule]", "100"}], ",", RowBox[{"PlotStyle", "\[Rule]", " ", RowBox[{"RGBColor", "[", RowBox[{"1", ",", " ", RowBox[{ RowBox[{"(", RowBox[{"i", "-", "1"}], ")"}], "/", RowBox[{"Length", "[", "tubes", "]"}]}], ",", " ", RowBox[{ RowBox[{"(", RowBox[{"i", "-", "1"}], ")"}], "/", RowBox[{"Length", "[", "tubes", "]"}]}]}], "]"}]}], ",", " ", RowBox[{"Mesh", "\[Rule]", "None"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", RowBox[{"Length", "[", "tubes", "]"}]}], "}"}]}], "]"}], ",", " ", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", " ", RowBox[{"Background", "\[Rule]", "Black"}], ",", " ", RowBox[{"Boxed", "\[Rule]", "False"}], ",", " ", RowBox[{"Axes", "\[Rule]", "False"}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", RowBox[{"{", RowBox[{"5", ",", " ", "0", ",", " ", "0"}], "}"}]}]}], "]"}]}], ";"}]}], "\[IndentingNewLine]", "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"MyTube", "[", RowBox[{"r_", ",", " ", "rad_"}], "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ "dr", ",", " ", "dr2", ",", " ", "n1", ",", " ", "b1", ",", " ", "cc", ",", " ", "tube"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"dr", " ", "=", " ", RowBox[{"D", "[", RowBox[{"r", ",", " ", "u"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"dr2", "=", " ", RowBox[{"D", "[", RowBox[{"dr", ",", " ", "u"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"n1", " ", "=", " ", RowBox[{"dr2", " ", "-", " ", RowBox[{ RowBox[{"(", RowBox[{"dr", " ", ".", " ", "dr2"}], ")"}], " ", RowBox[{"dr", "/", RowBox[{"(", RowBox[{"dr", " ", ".", " ", "dr"}], ")"}]}]}]}]}], ";", "\[IndentingNewLine]", RowBox[{"b1", " ", "=", " ", RowBox[{"Cross", "[", RowBox[{"n1", ",", " ", "dr"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"cc", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"Cos", "[", "v", "]"}], " ", "n1"}], " ", "+", " ", RowBox[{ RowBox[{"Sin", "[", "v", "]"}], " ", "b1"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"tube", " ", "=", " ", RowBox[{"r", " ", "+", " ", RowBox[{"rad", " ", RowBox[{"cc", "/", RowBox[{"Sqrt", "[", RowBox[{"cc", " ", ".", " ", "cc"}], "]"}]}]}]}]}], ";", "\[IndentingNewLine]", RowBox[{"Return", "[", "tube", "]"}], ";"}]}], "\[IndentingNewLine]", "]"}]}], " ", ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"DrawFiber", "[", RowBox[{"th0_", ",", " ", "op1_", ",", " ", "op2_"}], "]"}], " ", ":=", " ", RowBox[{"Block", "[", RowBox[{ RowBox[{"{", RowBox[{"f1", ",", " ", "g1", ",", " ", "c1", ",", " ", "c2"}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"f1", "=", " ", RowBox[{ RowBox[{ RowBox[{"Cos", "[", "th0", "]"}], " ", "milnorf"}], " ", "+", " ", RowBox[{ RowBox[{"Sin", "[", "th0", "]"}], " ", "milnorg"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"g1", " ", "=", RowBox[{ RowBox[{ RowBox[{"Sin", "[", "th0", "]"}], " ", "milnorf"}], " ", "-", RowBox[{ RowBox[{"Cos", "[", "th0", "]"}], " ", "milnorg"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"c1", " ", "=", " ", RowBox[{"Directive", "[", RowBox[{ RowBox[{"Specularity", "[", RowBox[{"White", ",", "30"}], "]"}], ",", RowBox[{"Opacity", "[", "op1", "]"}], ",", "Green"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"c2", " ", "=", " ", RowBox[{"Directive", "[", RowBox[{ RowBox[{"Specularity", "[", RowBox[{"White", ",", "30"}], "]"}], ",", " ", RowBox[{"Opacity", "[", "op2", "]"}], ",", "Orange"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Show", "[", " ", RowBox[{ RowBox[{"ContourPlot3D", "[", RowBox[{ RowBox[{"{", RowBox[{"f1", "\[Equal]", "0"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "4"}], ",", " ", "4"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"y", ",", " ", RowBox[{"-", "4"}], ",", " ", "4"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"z", ",", " ", RowBox[{"-", "4"}], ",", " ", "4"}], "}"}], ",", " ", RowBox[{"ColorFunction", "\[Rule]", " ", RowBox[{"Function", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", " ", "y", ",", " ", "z", ",", " ", "f"}], "}"}], ",", RowBox[{"If", "[", RowBox[{ RowBox[{"g1", ">", "0"}], ",", "c1", ",", " ", "c2"}], "]"}]}], "]"}]}], ",", " ", RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}], ",", " ", RowBox[{"Mesh", "\[Rule]", "None"}], ",", " ", RowBox[{"PlotPoints", "\[Rule]", "50"}], ",", " ", RowBox[{"BoundaryStyle", "\[Rule]", "None"}], ",", " ", RowBox[{"Lighting", "\[Rule]", "Automatic"}]}], "]"}], ",", " ", "milnorlink", ",", " ", RowBox[{"Boxed", "\[Rule]", "False"}], ",", " ", RowBox[{"Axes", "\[Rule]", "False"}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", RowBox[{"{", RowBox[{"5", ",", " ", "0", ",", " ", "0"}], "}"}]}], " ", ",", " ", RowBox[{"Background", "\[Rule]", "Black"}], ",", " ", RowBox[{"ImageSize", "\[Rule]", RowBox[{"{", RowBox[{"800", ",", " ", "600"}], "}"}]}]}], "]"}]}]}], "\[IndentingNewLine]", "]"}]}]}], "Input", CellChangeTimes->{{3.48553220747265*^9, 3.485532237744279*^9}, { 3.4855323089391327`*^9, 3.4855324332718725`*^9}, {3.4855324804119387`*^9, 3.4855326137021255`*^9}, {3.485532658852189*^9, 3.485532658892189*^9}, { 3.4855328487224545`*^9, 3.485532861832473*^9}, {3.4855328972625227`*^9, 3.4855329000725265`*^9}, {3.485532963592615*^9, 3.4855329947326593`*^9}, { 3.4855330400027227`*^9, 3.4855330765127735`*^9}, {3.4855341759768176`*^9, 3.48553420247494*^9}, {3.4855360945161424`*^9, 3.4855362614676356`*^9}, { 3.485536319000537*^9, 3.4855363501069913`*^9}, {3.485536446920761*^9, 3.4855364533167725`*^9}, {3.4855387766272535`*^9, 3.4855388060957055`*^9}, { 3.485548036500862*^9, 3.4855480632787733`*^9}, {3.485548095102762*^9, 3.48554809950033*^9}, {3.4855482379649563`*^9, 3.485548244450056*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Example \ \>", "Section", CellChangeTimes->{{3.485536672824758*^9, 3.4855366739791603`*^9}, 3.485548537617059*^9}], Cell[TextData[{ "\n", StyleBox["This initializes the fibration for ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["z", "2"], "-", " ", SuperscriptBox["w", "3"]}], TraditionalForm]], FontSize->16] }], "Text", CellChangeTimes->{{3.485536684103578*^9, 3.4855367343044662`*^9}}], Cell[BoxData[ RowBox[{"InitFiber", "[", RowBox[{"2", ",", " ", "3"}], "]"}]], "Input", CellChangeTimes->{{3.4855326250221415`*^9, 3.4855326447121687`*^9}, { 3.4855328759324927`*^9, 3.4855328759924927`*^9}, {3.4855329376625795`*^9, 3.4855329473125925`*^9}, {3.4855358536049194`*^9, 3.4855358551649218`*^9}, { 3.4855359267378473`*^9, 3.48553593948307*^9}, {3.4855363668146205`*^9, 3.485536368140623*^9}}], Cell[TextData[{ "\n", StyleBox["This the link, which turns out to be a (2, 3)-torus knot.", FontSize->16] }], "Text", CellChangeTimes->{{3.485536739343275*^9, 3.4855367578917074`*^9}}], Cell[BoxData["milnorlink"], "Input", CellChangeTimes->{{3.4855326722022076`*^9, 3.48553267409221*^9}}], Cell[TextData[{ "\n", StyleBox["This draws the double fiber (I'm changing the viewpoint, because \ it looks better).", FontSize->16] }], "Text", CellChangeTimes->{{3.485536772430933*^9, 3.4855368049569902`*^9}}], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{ RowBox[{"DrawFiber", "[", RowBox[{"0", ",", " ", "1", ",", " ", "1"}], "]"}], ",", " ", RowBox[{"ViewPoint", "\[Rule]", RowBox[{"{", RowBox[{"3", ",", " ", "3", ",", " ", "3"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.485536377329039*^9, 3.4855364129751015`*^9}, { 3.4855368077025948`*^9, 3.485536823458623*^9}, {3.4855368594322863`*^9, 3.485536906700369*^9}, {3.4855369484616423`*^9, 3.4855369838269043`*^9}}], Cell[TextData[{ "\n", StyleBox["This is only the green fiber. The orange fiber is being drawn, \ but it is transparent. This makes the drawing much slower.", FontSize->16] }], "Text", CellChangeTimes->{{3.4855369963693266`*^9, 3.4855370045749407`*^9}, { 3.4855370555402308`*^9, 3.4855370874734864`*^9}}], Cell[BoxData[ RowBox[{"DrawFiber", "[", RowBox[{"0", ",", " ", "1", ",", " ", "0"}], "]"}]], "Input", CellChangeTimes->{{3.48553700972295*^9, 3.4855370222653723`*^9}}], Cell[TextData[{ "\n", StyleBox["A table of four different fibers.", FontSize->16] }], "Text", CellChangeTimes->{{3.485537116208737*^9, 3.4855371373935738`*^9}}], Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{"DrawFiber", "[", RowBox[{ RowBox[{ RowBox[{"Pi", "/", "8"}], " ", "k"}], ",", " ", "1", ",", " ", "0"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"k", ",", " ", "0", ",", " ", "3"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4855371294531603`*^9, 3.4855371706060324`*^9}, { 3.4855373885072155`*^9, 3.485537390004818*^9}, {3.4855483339389305`*^9, 3.4855483369089766`*^9}, {3.485548411715125*^9, 3.485548413712656*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Creating a Movie \ \>", "Section", CellChangeTimes->{{3.485537719305796*^9, 3.4855377257330074`*^9}, 3.485548540847109*^9}], Cell[TextData[{ StyleBox["\nThe movies are created by making a sequence of pictures, \ creating a high-quality version of the picture using ", FontSize->16], StyleBox["Rasterize", FontSize->16, FontWeight->"Bold"], StyleBox[", then saving the picture to a disk drive. Then ", FontSize->16], StyleBox["Mathematica", FontSize->16, FontSlant->"Italic"], StyleBox[" loads all of the pictures and creates a movie out of them. The \ movie it creates looks great, but it is very, very large. \n\nThe following \ code will make a ten second movie showing the green fibration of ", FontSize->16], Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["z", "2"], "-", " ", SuperscriptBox["w", "3"]}], TraditionalForm]], FontSize->16], StyleBox[". It will take a very long time to create this (about an hour on \ my computer). The good news: after each picture is created, it is saved, so \ this can be done in stages if necessary. The entire size of the disk will be \ 823 MB.\n\nFirst you need a path for the directory where all of this will be \ saved:", FontSize->16], "\n" }], "Text", CellChangeTimes->{{3.4855377364190264`*^9, 3.485538015846717*^9}, { 3.4855382160730686`*^9, 3.485538217991872*^9}, {3.4855479908676615`*^9, 3.4855479952977295`*^9}, {3.4855484882713013`*^9, 3.4855485068965874`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"milnorpath", " ", "=", " ", "\"\\""}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"InitFiber", "[", RowBox[{"2", ",", " ", "3"}], "]"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"frames", " ", "=", " ", "300"}], ";"}], "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"creates", " ", "the", " ", RowBox[{"pictures", ":", " ", RowBox[{ "change", " ", "the", " ", "parameters", " ", "in", " ", "DrawFiber", " ", "to", " ", "get", " ", "a", " ", "different", " ", "movie"}]}]}], " ", "*)"}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"For", "[", RowBox[{ RowBox[{"i", "=", "0"}], ",", " ", RowBox[{"i", "\[LessEqual]", " ", RowBox[{"frames", "-", "1"}]}], ",", " ", RowBox[{"i", "++"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"aa", " ", "=", " ", RowBox[{"DrawFiber", "[", RowBox[{ RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "frames"}]}], ",", " ", "1", ",", " ", "0"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Export", "[", RowBox[{ RowBox[{"milnorpath", "<>", " ", "\"\\"", "<>", " ", RowBox[{"ToString", "[", RowBox[{"100", "+", "i"}], "]"}], "<>", " ", "\"\<.bmp\>\""}], ",", " ", RowBox[{"Rasterize", "[", RowBox[{"aa", ",", " ", RowBox[{"ImageResolution", "\[Rule]", "200"}]}], "]"}]}], "]"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";"}], "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"creates", " ", "the", " ", "movie"}], " ", "*)"}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{"bb", " ", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"Import", "[", RowBox[{"milnorpath", "<>", " ", "\"\\"", "<>", " ", RowBox[{"ToString", "[", RowBox[{"100", "+", "i"}], "]"}], "<>", " ", "\"\<.bmp\>\""}], "]"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "0", ",", " ", RowBox[{"frames", "-", "1"}]}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Export", "[", RowBox[{ RowBox[{"milnorpath", "<>", "\"\\""}], ",", " ", "bb"}], "]"}], ";"}], "\[IndentingNewLine]"}], "Input", CellChangeTimes->{{3.4855380190603228`*^9, 3.485538357565317*^9}, { 3.4855385252796125`*^9, 3.485538529164019*^9}, {3.4855389374791365`*^9, 3.4855389436255474`*^9}}] }, Closed]] }, Open ]] }, WindowSize->{1904, 945}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, FrontEndVersion->"7.0 for Microsoft Windows (64-bit) (February 18, 2009)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[567, 22, 345, 10, 83, "Title"], Cell[915, 34, 210, 9, 227, "Section"], Cell[CellGroupData[{ Cell[1150, 47, 132, 4, 67, "Section"], Cell[1285, 53, 5662, 212, 354, "Text"], Cell[6950, 267, 13513, 330, 619, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[20500, 602, 129, 5, 67, "Section"], Cell[20632, 609, 314, 11, 51, "Text"], Cell[20949, 622, 417, 7, 31, "Input"], Cell[21369, 631, 189, 5, 51, "Text"], Cell[21561, 638, 103, 1, 31, "Input"], Cell[21667, 641, 216, 6, 51, "Text"], Cell[21886, 649, 496, 10, 31, "Input"], Cell[22385, 661, 312, 7, 51, "Text"], Cell[22700, 670, 172, 3, 31, "Input"], Cell[22875, 675, 165, 5, 51, "Text"], Cell[23043, 682, 516, 12, 31, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[23596, 699, 138, 5, 67, "Section"], Cell[23737, 706, 1339, 32, 183, "Text"], Cell[25079, 740, 2584, 67, 292, "Input"] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)