(* 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[     30541,        899]
NotebookOptionsPosition[     29441,        860]
NotebookOutlinePosition[     29785,        875]
CellTagsIndexPosition[     29742,        872]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell[TextData[{
 "Milnor Fibrations for ",
 Cell[BoxData[
  FormBox[
   RowBox[{
    SuperscriptBox["z", "m"], "-", " ", 
    RowBox[{"z", " ", 
     SuperscriptBox["w", "n"]}]}], TraditionalForm]], "None"]
}], "Title",
 CellChangeTimes->{{3.485530733643811*^9, 3.485530738653818*^9}, {
  3.4855308417235785`*^9, 3.4855308856536407`*^9}, {3.4862259080967045`*^9, 
  3.48622592799937*^9}, {3.486227476279809*^9, 3.486227481849045*^9}}],

Cell["\<\
Author: Dan Dreibelbis
University of North Florida
ddreibel@unf.edu
www.unf.edu/~ddreibel

Last Modified: 6/22/2010
\
\>", "Section",
 CellChangeTimes->{{3.4855309281036997`*^9, 3.48553098546378*^9}, {
  3.4862259456091733`*^9, 3.4862259460615063`*^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[a, b, c] - ",
  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"], "-", " ", 
    RowBox[{"z", " ", 
     SuperscriptBox["w", "n"]}]}], TraditionalForm]], "None",
  FontSize->16],
 StyleBox[", intersected with the hypersphere of radius ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SqrtBox["2"], TraditionalForm]],
  FontSize->16],
 StyleBox[" in ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SuperscriptBox["\[DoubleStruckCapitalR]", "4"], TraditionalForm]],
  FontSize->16],
 StyleBox[", then stereographically projected into ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]],
  FontSize->16],
 StyleBox[" from the point ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   RowBox[{"(", 
    RowBox[{
     SqrtBox["2"], ",", " ", "0", ",", " ", "0", ",", " ", "0"}], ")"}], 
   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"], "-", " ", 
    RowBox[{"z", " ", 
     SuperscriptBox["w", "n"]}]}], TraditionalForm]], "None",
  FontSize->16],
 StyleBox[", intersected with the hypersphere of radius ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SqrtBox["2"], TraditionalForm]],
  FontSize->16],
 StyleBox[" in ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SuperscriptBox["\[DoubleStruckCapitalR]", "4"], TraditionalForm]],
  FontSize->16],
 StyleBox[", then stereographically projected into ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]],
  FontSize->16],
 StyleBox[" from the point ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   RowBox[{"(", 
    RowBox[{
     SqrtBox["2"], ",", " ", "0", ",", " ", "0", ",", " ", "0"}], ")"}], 
   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"], "-", " ", 
    RowBox[{"z", " ", 
     SuperscriptBox["w", "n"]}]}], TraditionalForm]],
  FontSize->16],
 StyleBox[".  We get the link by intersecting ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   RowBox[{
    RowBox[{
     SuperscriptBox["z", "m"], "-", " ", 
     RowBox[{"z", " ", 
      SuperscriptBox["w", "n"]}]}], "=", "0"}], TraditionalForm]],
  FontSize->16],
 StyleBox[" with the  hypersphere of radius ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SqrtBox["2"], TraditionalForm]],
  FontSize->16],
 StyleBox[" in ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SuperscriptBox["\[DoubleStruckCapitalR]", "4"], TraditionalForm]],
  FontSize->16],
 StyleBox[",  then stereographically projected into ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   SuperscriptBox["\[DoubleStruckCapitalR]", "3"], TraditionalForm]],
  FontSize->16],
 StyleBox[" from the point ",
  FontSize->16],
 Cell[BoxData[
  FormBox[
   RowBox[{"(", 
    RowBox[{
     SqrtBox["2"], ",", " ", "0", ",", " ", "0", ",", " ", "0"}], ")"}], 
   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, {3.4862259552173567`*^9, 3.4862260124453173`*^9}, {
   3.4862274864510746`*^9, 3.486227510069626*^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[{"u", " ", 
           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", ",", 
            RowBox[{"n", "+", "1"}]}], "]"}]}]}]}], ";", 
       "\[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", "/", 
                  RowBox[{"(", 
                   RowBox[{"m", "-", "1"}], ")"}]}]}]}], "]"}]}], ",", 
             RowBox[{"y", "->", 
              RowBox[{"Sin", "[", 
               RowBox[{
                RowBox[{"n", " ", "u"}], "+", 
                RowBox[{"2", " ", "Pi", " ", 
                 RowBox[{"k", "/", 
                  RowBox[{"(", 
                   RowBox[{"m", "-", "1"}], ")"}]}]}]}], "]"}]}], ",", 
             RowBox[{"z", "->", 
              RowBox[{"Cos", "[", 
               RowBox[{
                RowBox[{"(", 
                 RowBox[{"m", "-", "1"}], ")"}], " ", "u"}], "]"}]}], ",", 
             RowBox[{"w", "->", 
              RowBox[{"Sin", "[", 
               RowBox[{
                RowBox[{"(", 
                 RowBox[{"m", "-", "1"}], ")"}], " ", "u"}], "]"}]}]}], 
            "}"}]}], ",", " ", 
          RowBox[{"{", 
           RowBox[{"k", ",", " ", "0", ",", " ", 
            RowBox[{
             RowBox[{"GCD", "[", 
              RowBox[{
               RowBox[{"(", 
                RowBox[{"m", "-", "1"}], ")"}], ",", " ", "n"}], "]"}], "-", 
             "1"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", 
       RowBox[{"AppendTo", "[", 
        RowBox[{"curves", ",", " ", 
         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", "\[Rule]", "0"}], ",", " ", 
            RowBox[{"y", "\[Rule]", "0"}], ",", " ", 
            RowBox[{"z", "\[Rule]", " ", 
             RowBox[{
              RowBox[{"Sqrt", "[", "2", "]"}], " ", 
              RowBox[{"Cos", "[", "u", "]"}]}]}], ",", " ", 
            RowBox[{"w", "\[Rule]", 
             RowBox[{
              RowBox[{"Sqrt", "[", "2", "]"}], " ", 
              RowBox[{"Sin", "[", "u", "]"}]}]}]}], "}"}]}]}], "]"}], ";", 
       "\[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->CompressedData["
1:eJxTTMoPSmViYGCQAGIQ/Vn+PavCj5eOShe3c4LoBN55QiBab7OGEoiepcer
AaIvlG+zAKtzjbYD83tiwHSknHgYiJ63eFc4iJ6WphEDopWDmsD0lm9FKSD6
U2F4Boj2E2PIA9FLMiYUgWhxp/+/QfRWI///INq25cJrRSB9/9s6BiUgncby
gB1EV+Yc5gbRD8ruioNoBuVVEiC6TEjEWhlIswoctgPRAuwTDqgD6W2vXxwG
0Vc8Hx8H0VuYCk6A6DcP9t0E0XfS+m6BaIH+36eLfr50PHlt2lkQ7XDz/2MQ
vePGrF8g2q7uGXMxkL5T9JcTRC8I29YOom0KlLtB9JPLvhNAdJL0DTD95YHQ
VBCdKnp+AYiWmmC8AkS/up6xBkTn3D7HUAKkZ926AKYBu8fTCw==
  "]]
}, 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", "3"], "-", " ", 
    RowBox[{"z", " ", 
     SuperscriptBox["w", "2"]}]}], TraditionalForm]],
  FontSize->16],
 "."
}], "Text",
 CellChangeTimes->{{3.485536684103578*^9, 3.4855367343044662`*^9}, {
  3.4862285308933697`*^9, 3.486228561297964*^9}}],

Cell[BoxData[
 RowBox[{"InitFiber", "[", 
  RowBox[{"3", ",", " ", "2"}], "]"}]], "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}, {3.4862279042373524`*^9, 3.486227904268553*^9}, {
  3.4862281017502184`*^9, 3.4862281018126187`*^9}, {3.4862283484189997`*^9, 
  3.4862283498854094`*^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 (note the front and back of the fibers \
have been cut off, due to the plot range).",
  FontSize->16]
}], "Text",
 CellChangeTimes->{{3.485536772430933*^9, 3.4855368049569902`*^9}, {
  3.486228644540098*^9, 3.486228662152611*^9}}],

Cell[BoxData[
 RowBox[{"DrawFiber", "[", 
  RowBox[{"0", ",", " ", "1", ",", " ", "1"}], "]"}]], "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}, {
  3.486228596881792*^9, 3.4862286343532324`*^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", " ", "=", " ", "\"\<c:\\\\milnor\\\\\>\""}], 
  ";"}], "\[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", "<>", " ", "\"\<fiber23\>\"", "<>", " ", 
         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", "<>", " ", "\"\<fiber23\>\"", "<>", " ", 
       RowBox[{"ToString", "[", 
        RowBox[{"100", "+", "i"}], "]"}], "<>", " ", "\"\<.bmp\>\""}], "]"}], 
     ",", " ", 
     RowBox[{"{", 
      RowBox[{"i", ",", " ", "0", ",", " ", 
       RowBox[{"frames", "-", "1"}]}], "}"}]}], "]"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Export", "[", 
   RowBox[{
    RowBox[{"milnorpath", "<>", "\"\<fiber23.avi\>\""}], ",", " ", "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->{1008, 647},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
FrontEndVersion->"7.0 for Microsoft Windows (32-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, 434, 11, 83, "Title"],
Cell[1004, 35, 263, 10, 227, "Section"],
Cell[CellGroupData[{
Cell[1292, 49, 132, 4, 67, "Section"],
Cell[1427, 55, 5476, 205, 450, "Text"],
Cell[6906, 262, 15114, 382, 855, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[22057, 649, 129, 5, 67, "Section"],
Cell[22189, 656, 397, 14, 51, "Text"],
Cell[22589, 672, 571, 9, 31, "Input"],
Cell[23163, 683, 189, 5, 51, "Text"],
Cell[23355, 690, 103, 1, 31, "Input"],
Cell[23461, 693, 292, 7, 51, "Text"],
Cell[23756, 702, 376, 6, 31, "Input"],
Cell[24135, 710, 312, 7, 51, "Text"],
Cell[24450, 719, 172, 3, 31, "Input"],
Cell[24625, 724, 165, 5, 51, "Text"],
Cell[24793, 731, 516, 12, 31, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[25346, 748, 138, 5, 67, "Section"],
Cell[25487, 755, 1339, 32, 183, "Text"],
Cell[26829, 789, 2584, 67, 292, "Input"]
}, Closed]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)