(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 3.0,
MathReader 3.0, or any compatible application. The data for the notebook
starts with the line of 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[ 59565, 1429]*)
(*NotebookOutlinePosition[ 60355, 1457]*)
(* CellTagsIndexPosition[ 60311, 1453]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{
Cell[TextData[{
"Tubagraphics \n",
StyleBox[
"(June 1999) by M A Berger, Mathematics, University College London",
FontSize->12,
FontColor->GrayLevel[0]]
}], "Section",
InitializationCell->True,
FontFamily->"Courier",
FontSize->24,
FontColor->RGBColor[0, 0, 1]],
Cell[BoxData[
\(\(Print[
"\"]\ \)\)],
"Input",
CellLabel->"In[1]:=",
InitializationCell->True],
Cell[BoxData[
\(BeginPackage["\", \ "\"]; \
Off[General::spell1]; \)], "Input",
CellLabel->"In[2]:=",
InitializationCell->True],
Cell[CellGroupData[{
Cell["Usage Messages", "Section",
InitializationCell->True,
FontFamily->"Courier"],
Cell[CellGroupData[{
Cell["normalize, rotate, curveinterp, todata, slidebraid", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(normalize::usage\ = \ \n\ "\"; \nrotate::usage\ = \ \n\
"\"; \ncurveinterp::usage\ = \ \n\
"\"; \ntodata::usage\ = \n
"\"; \n
slidebraid::usage =
"\"; \)], "Input",
CellLabel->"In[3]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["tube, quicktube, checkedcurve", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(tube::usage\ = \n\
\*"\"\ \!\(\[DoubleStruckCapitalR]\^3\). \n\t\
\t\n\t\tLet the variable s measure position the short way around, going from \
0 to 1. Also let t measure position the long way around (along the axis), \
also varying from 0 to 1.\n\t\tBoth shape and color can be constants or \
functions of [s,t].\n\t\tIf shape is a number, then the radius of the tube \
will be shape. Otherwise, the radius is given by shape[s,t].\n\t\t\n\t\tColor \
can be a single graphics directive or list of graphics directives. \n\t\tAn \
assignment like color[s_,t_] := {EdgeForm[],Hue[s]} \n\t\twill automatically \
be translated to {EdgeForm[],SurfaceColor[Hue[s]]}. \n\t\tThis works for \
RGBColor, Hue, and CMYKColor, as well as the\n\t color names listed in \
AllColors (part of Graphics`Colors package automatically loaded by tuba.m).\n\
\t\t\n\t\tFor a frenettube (the default), numerical differentiation is used \
to find normal and binormals, with avoidance of flips at inflection points. \
Other algorithms are available. If the first and last points in curve are \
identical then tube assumes a closed curve. \n\t\n\t\t\tThere are several \
options:\n\t\t1. naroundtube -> na gives na points in azimuthal direction \
(default = 12);\n\t\t2. nalongtube -> nc gives nc points in axial direction \
along curve (default 40);\n\t\t3. tuberange -> myfun will only plot parts \
of the surface inside the region myfun(x,y,z) \[GreaterEqual] 0. \n\t\t4. \
tubehelicity-> hh will add hh units of twist (in units of 2\[Pi] radians). \
The default is hh = 0; this gives zero framing (zero helicity).\n \t 5. \
tubealgorithm -> xytube will plot circles perpendicular to curve in xy plane. \
tubealgorithm -> {a,b,c} gets normal by crossing tangent with fixed vector \
{a,b,c}. Default\n is frenettube, which uses normal and binormal for \
circles.\>\""; \)\)], "Input",
CellLabel->"In[4]:=",
InitializationCell->True],
Cell["\<\
tubedefaults::usage = \"default tube options\";
tuberange::usage= \"tube option\";
tubehelicity::usage =\"tube option, default = 0\";
tubealgorithm::usage = \"tube option, default = frenettube = 1.(xytube = \
2)\";
naroundtube::usage = \"tube option, default = 12\";
nalongtube::usage = \"tube option, default = 40 \";
frenettube::usage = \"tubalgorithm option (=1)\";
xytube::usage = \"tubealgorithm option (=2)\";\
\>", "Input",
CellLabel->"In[5]:=",
InitializationCell->True],
Cell[BoxData[
\(quicktube::usage\ = \
"\"; \n
checkedcurve::usage\ = \
"\"; \)], "Input",
CellLabel->"In[13]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["fluxlines", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(fluxlines::usage\ = \
"\ th gives thickness of lines th (default 0.005);
2 fluxcolor ->c determines color c of lines (default GrayLevel[0]).\>";
\)\)], "Input",
CellLabel->"In[14]:=",
InitializationCell->True],
Cell[BoxData[
\(fluxthickness::usage\ = \ \ "\"; \n
fluxcolor::usage\ = \ \ "\ "; \)], "Input",
CellLabel->"In[15]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["arrow, sidearrow", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(arrowcolor::usage\ = \ \ \ "\"; \n
arrowthickness::usage\ = \ \ \ "\"; \n
arrow::usage\ = \ \n\
"\ color gives surface color;
2. arrowthickness -> th The thickness of the arrow is th|q-p| (default th \
= 0.1);
\>"; \nsidearrow::usage\ = \ \n\
"\ {-1,1,3}] to change ViewPoint so that \
sidearrow knows about it (changing from inside graphics3D will leave the \
default ViewPoint unchanged).
Sidearrow is meant to stick onto a tube plot. You can rotate it around the \
tube by the angle theta.\>"; \)], "Input",
CellLabel->"In[16]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["tress", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell["\<\
braidcolors::usage = \"tress option\";
pedestal::usage = \"tress option: pedestal -> {4,0.75} (the default), makes \
the margin between the side of the pedestal and the tubes equal to 4 * radius \
(of a tube). Also the thickness of the pedestal becomes 0.75 radius\";
nicecolors::usage = \"list of common colors\";
tresswidth::usage = \"returns width of bounding box for tress\";
tress::usage =
\"tress[braid] takes a set of curves and draws tubes for each curve with a \
pedestal at bottom and top. Options:
\t\tbraidcolours->default selects colours for you (with repeats for more than \
10 colours).
\t\tbraidcolours->list colours tube1 with first colour in list, e.g. \
RGBColor[1,1,0], etc.
\t\tpedestal -> {4,0.75} (the default), makes the margin between the side of \
the pedestal and the tubes
\t\tequal to 4 * radius (of a tube). Also the thickness of the pedestal \
becomes 0.75 radius\"; \
\>", "Input",
CellLabel->"In[17]:=",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["Code", "Section",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(Begin["\<`Private`\>"]; \)\)], "Input",
CellLabel->"In[22]:=",
InitializationCell->True],
Cell[CellGroupData[{
Cell["Basic Data Type: curvedata", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(curvedata\ = \ x : {{_?NumericQ, _?NumericQ, _?NumericQ} .. };
\)\)], "Input",
CellLabel->"In[23]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["User functions: normalize, rotate, curveinterp, todata", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
\(normalize[v_]\ := \ N[v/\ Sqrt[v . v]]\),
\(rotate[v_, \ theta_]\ :=
\ {{Cos[theta], \ Sin[theta]}, {\(-Sin[theta]\), \ Cos[theta]}}\ . \
v; \ncurveinterp[curve_, \ ncurve_]\ := \
Module[\n\t\t{tran, \ inter, \ t, \ morepoints, \ npoints, \
interporder, \ i}, \ tran\ = \ Transpose[curve]; \ \n\t\t
npoints\ = \ Length[curve];
interporder\ = \ If[npoints > 3, 3, npoints - 1]; \n\t\t\
inter\ = \
Map[Interpolation[#, \ InterpolationOrder -> interporder]&, \
tran]; \ \n\t\t
t[i_]\ := \
N[\((i - 1)\) \((npoints\ - \ 1)\)/\((ncurve\ - \ 1)\)\ + \ 1];
\n\t\tmorepoints[ifun_]\ := \ \n\t\t
Append[Prepend[\ \
Table[N[ifun[t[i]]], \ {i, \ 2, \ ncurve\ - 1}], \ \n\t\t\t\t\t
N[ifun[1]]], N[ifun[npoints]]\ ]; \n\ \ \ \ \ \
Transpose[\ Map[morepoints, \ inter]\ ]\n\t\t]\),
\(todata[fun_Symbol, \ nx_]\ := \
Table[N[fun[\((i - 1)\)/\((nx - 1)\)]], \ {i, \ 1, \ nx}]; \n
todata[fun_Symbol, \ nx_, \ ny_] := \ \n\t\t\
Table[fun[\((i - 1)\)/\((nx - 1)\)\ , \((j - 1)\)/\((ny - 1)\)],
\ {i, nx}, \ {j, \ ny}]; \)}], "Input",
CellLabel->"In[24]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Derivative routines", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
RowBox[{"\t",
RowBox[{
\(weirdvector\ := \ \ normalize[{Pi + \ 1, 3.7, 1.9}]\), ";", "\n",
"\t", \(deriv[c_]\ :=
0.5\ *\ If[First[c]\ == \ Last[c], \ \n\t\t\t\t\
Module[{ccut\ = \ Drop[c, \ \(-1\)], \ derivcut}, \ \
derivcut\ = \ RotateLeft[ccut]\ - \ RotateRight[ccut]; \n
\t\t\t\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ Append[derivcut, \ First[derivcut]]\ ], \n\t\t\t\ \ \
Module[{np\ = \ Length[c], \ i}, \ \n
\t\t\t\t\t\t\ \ \ \ \ \ \ \ \ \ \
N[Append[
Prepend[
Table[\((
c\[LeftDoubleBracket]i + 1\[RightDoubleBracket]\ -
\ c\[LeftDoubleBracket]i - 1\[RightDoubleBracket])
\), \ {i, \ 2, \ np\ - 1}], \n
\t\t\t\t\t\t\t\t\t\ \ \ \
2 \((\ c\[LeftDoubleBracket]3\[RightDoubleBracket] -
c\[LeftDoubleBracket]1\[RightDoubleBracket])
\)\ - \
\((c\[LeftDoubleBracket]4\[RightDoubleBracket] -
c\[LeftDoubleBracket]2\[RightDoubleBracket])\)],
\ 2 \((c\[LeftDoubleBracket]np\[RightDoubleBracket]\ - \
c\[LeftDoubleBracket]np - 2\[RightDoubleBracket])
\)\ - \
\((c\[LeftDoubleBracket]np - 1
\[RightDoubleBracket]\ \ - \ \
c\[LeftDoubleBracket]np - 3\[RightDoubleBracket])
\)\ ]]]\ ]\), ";", "\n", " ", "\n",
StyleBox[
\( (*\ Normal\ vector, \
including\ removing\ jumps\ by\ pi\ at\ inflection\ points\ *)
\),
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]], "\n", " ",
\(normalvector[tangent_]\ := \
Module[{np\ = \ Length[tangent], \ n1, \ vv, \ vw, \ i}, \n
\t\t\t\t\ n1\ = \ deriv[tangent]; \n\t\t
n1\[LeftDoubleBracket]1\[RightDoubleBracket]\ = \
Module[{v2\ = \
N[\ n1\[LeftDoubleBracket]1\[RightDoubleBracket] . \
n1\[LeftDoubleBracket]1\[RightDoubleBracket]]}, \
If[v2\ != \ 0,
normalize[\ n1\[LeftDoubleBracket]1\[RightDoubleBracket]],
\n\t\tnormalize[
Cross[tangent\[LeftDoubleBracket]1\[RightDoubleBracket],
\ weirdvector]]]\ ]\ ; \ \n\t\t
Do[\n\t\t\t{
vv\ = \
n1\[LeftDoubleBracket]i\[RightDoubleBracket] .
n1\[LeftDoubleBracket]i\[RightDoubleBracket]; \
If[vv\ > \ 10^\(-6\),
n1\[LeftDoubleBracket]i\[RightDoubleBracket]\ = \
n1\[LeftDoubleBracket]i\[RightDoubleBracket]/Sqrt[vv], \
n1\[LeftDoubleBracket]i\[RightDoubleBracket]\ = \
n1\[LeftDoubleBracket]i - 1\[RightDoubleBracket]]; \ \n
\t\t\t\t\t\t
vw\ = \
n1\[LeftDoubleBracket]i\[RightDoubleBracket] .
n1\[LeftDoubleBracket]i - 1\[RightDoubleBracket]; \
If[vw\ < \ 0, \
n1\[LeftDoubleBracket]i\[RightDoubleBracket]\ = \
\(-n1\[LeftDoubleBracket]i\[RightDoubleBracket]\)]},
\ {i, \ 2, \ np}\n\t\t\t]; \ n1]\), ";"}]}]], "Input",
CellLabel->"In[27]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["\<\
Utility functions for restricting tubes to region specified by tuberange\
\>", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
RowBox[{
\(interpoint[x_, \ y_, \ i_]\ := \
Module[{j\ = \ Mod[i, \ 4]\ + \ 1}, \n\t\t
x\[LeftDoubleBracket]j\[RightDoubleBracket]\ - \
\((y\[LeftDoubleBracket]j\[RightDoubleBracket]/
\((y\[LeftDoubleBracket]j\[RightDoubleBracket]\ - \
y\[LeftDoubleBracket]i\[RightDoubleBracket])\)\ )\)
\((x\[LeftDoubleBracket]j\[RightDoubleBracket]\ - \
x\[LeftDoubleBracket]i\[RightDoubleBracket])\)]\), "\n",
"\t\t"}],
RowBox[{
\(slice[poly_, \ funvalues_]\ := \
Module[{test, \ signs, \ edges, \ newpoly = {}, \ i}, \
signs\ = \ Sign[funvalues]; \
edges\ = \n\t\t\tsigns\ *\ RotateLeft[signs];
Do[{\ If[signs\[LeftDoubleBracket]i\[RightDoubleBracket]\ == \ 1,
\ newpoly\ = \ Append[newpoly, Extract[poly, i]]], \n
\t\t\t\t\ \ \ \ \
If[edges\[LeftDoubleBracket]i\[RightDoubleBracket]\ == \
\(-1\), \
newpoly\ = \
Append[newpoly, \ interpoint[poly, \ funvalues, \ i]\ ]
\ ]}, \ {i, \ 4}]; newpoly\n\t\t]\), ";", "\n", "\n",
\(zap[poly_, \ funtest_]\ := \
Module[{funvalues, howmanybadpoints}, \
funvalues\ = \ Map[funtest, \ poly]; \
howmanybadpoints\ = \ Count[funvalues, x_ /; x < 0]; \
Which[howmanybadpoints\ == \ 0, \ poly, \ \n
\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ howmanybadpoints\ == \ \ 4, \
Null, \n\t\ \ \ \ \ \ \ \ \ \ \ True, \ slice[poly, \ funvalues]]
\n\t\ \ \ \ \ \ \ \ \ \ \ ]\), ";", "\n", "\n",
StyleBox[
\( (*\ crop\ polygons\ from\ uncolored\ list\ of\ polygons\ *) \),
FontColor->RGBColor[1, 0, 0]], "\n",
\(crop[polylist_, \ funtest_]\ := \
DeleteCases[Map[zap[#, \ funtest]&, \ polylist], \ Null]\), ";",
"\n",
StyleBox[
\( (*\ crop\ polygons\ from\ colored\ list\ of\ polygons\ *) \),
FontColor->RGBColor[1, 0, 0]], "\n",
RowBox[{
RowBox[{
StyleBox[
RowBox[{"colo",
StyleBox["r",
FontColor->GrayLevel[0]], "crop"}]], "[", \(polylist_, \
funtest_\), "]"}],
StyleBox[" ",
FontColor->GrayLevel[0]], ":=", " ",
\(Module[{biglist},
biglist\ = \
Map[MapAt[zap[#, funtest]&, \ #, \ \(-1\)]&, \ polylist]; \n\t
DeleteCases[biglist,
x_ /; x\[LeftDoubleBracket]\(-1\)\[RightDoubleBracket] == Null]]
\)}], ";"}]}], "Input",
CellLabel->"In[28]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Algorithms for getting normals and constructing lattice",
"Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
RowBox[{
RowBox[{
RowBox[{\(getnormals[curve_, \ algo_]\), " ", ":=", " ",
RowBox[{"Module", "[",
RowBox[{
\({\ ncurve\ = \ Length[curve], \ tangent, \ normal, \ binormal,
\ i}\), ",", "\n", "\t",
RowBox[{
RowBox[{"Switch", "[",
RowBox[{
"algo", ",", "\n", "\t\t\t", \(x : {_, _, _}\), ",", " ",
\({\n\t\t\t\t\ \
tangent\ \ \ = \ Map[normalize, \ deriv[curve]], \n
\t\t\t\t\ \
normal\ \ \ \ \ = \
Map[normalize, \ \ Map[Cross[#, algo]&, \ tangent]],
\n\t\t\t\ \ \ \
binormal\ = MapThread[Cross, \ {tangent, \ normal}]\ }
\), ",", " ", "\n", "\t\t ", "xytube", ",",
\({\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \
normal\ = \ Table[{0.6, \ 0.8, 0}, \ {i, \ ncurve}],
binormal\ = \
Table[{0.8, \ \(-0.6\), \ 0}, \ {i, \ ncurve}]\ }\),
",", "\n", "\t\t",
StyleBox[\( (*\ default\ or\ frenettube\ *) \),
FontColor->RGBColor[1, 0, 0]], "_", ",",
\({\n\ \ \ \ \ \ \ \ \ \ \ \
tangent\ \ \ = \ Map[normalize, \ deriv[curve]], \n
\ \ \ \ \ \ \ \ \ \ \ \
normal\ \ \ \ \ = \ normalvector[tangent], \n
\t\t\ \ \ \ \ \
binormal\ = MapThread[Cross, \ {tangent, \ normal}]\ }
\)}], " ", "\n", "\t\t", "]"}], ";", " ",
\(Transpose[{normal, \ binormal}]\)}]}], "\n", "\t", "]"}]}],
";"}], "\t"}]], "Input",
CellLabel->"In[30]:=",
InitializationCell->True],
Cell[BoxData[
RowBox[{"\t",
RowBox[{
RowBox[{
\(getlattice[curve_, \ shapefun_, \ naround_, \ nalong_, \ helicity_,
\ algo_]\), ":=", " ",
RowBox[{"Module", "[",
RowBox[{
\({costable, sintable, bothnormals, i, j, offset, \ lattice}\),
",", " ", "\n",
StyleBox[
\( (*\ Choose\ algorithm\ to\ calculate\ normal\ and\ binormal
\ *) \),
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]], "\n", "\t\t ",
RowBox[{
\(bothnormals\ = \ getnormals[curve, \ algo]\), ";", "\n",
StyleBox[\( (*\ Add\ extra\ twist\ *) \),
FontColor->RGBColor[1, 0, 0]], "\n", "\t\t",
\(If[helicity\ != \ 0, \
Module[{angle, \ newvecs}, \
angle[t_]\ := \
N[2\ Pi\ \((t - 1)\)\ helicity/\ \((nalong - 1)\)]; \n
\t\t\tbothnormals\ = \
Table[rotate[\
bothnormals\[LeftDoubleBracket]i
\[RightDoubleBracket]\ , \ \ angle[i]]\ ,
\ {i, \ 1, \ nalong}]\n\t\t\t\t]\ ]\), ";", "\n",
StyleBox[
\( (*\ Table\ look\ up\ speeds\ things\ \(up!\)\ *) \),
FontColor->RGBColor[1, 0, 0]], "\n", " \t\t",
\(costable\ = \
Table[N[Cos[2\ Pi\ j/naround]], \ {j, \ 1, \ naround}]\),
";", "\n", "\t ",
\(sintable\ = \
Table[N[Sin[2\ Pi\ j/naround]], \ {j, \ 1, \ naround}]\),
";", "\n",
StyleBox[
\( (*\ Calculate\ positions\ of\ vertices . \ offset\ is\
added\ to\ curve\ to\ get\ to\ the\ surface . \ If\
neccessary, \
create\ radiustable\ if\ radius\ is\ a\ function\ of\
position\ \(shapefun . \)\ *) \),
FontColor->RGBColor[1, 0, 0]], "\t", "\n", "\t",
\(offset\ = \
If[NumberQ[shapefun],
shapefun\ *\
Table[{costable\[LeftDoubleBracket]j
\[RightDoubleBracket], \
sintable\[LeftDoubleBracket]j
\[RightDoubleBracket]} . \
bothnormals\[LeftDoubleBracket]i
\[RightDoubleBracket], {j, \ 1, \ naround}, {i, \
1, \ nalong}], \t\t\t\n\t
Module[{radiustable}, \
radiustable\ = todata[shapefun, \ naround, \ nalong];
\n\t\t\t\t\t
Table[\ radiustable\[LeftDoubleBracket]j, i
\[RightDoubleBracket] {
costable\[LeftDoubleBracket]j
\[RightDoubleBracket], \
sintable\[LeftDoubleBracket]j
\[RightDoubleBracket]} . \
bothnormals\[LeftDoubleBracket]i
\[RightDoubleBracket], {j, \ 1, \ naround}, {i,
\ 1, \ nalong}]]\n\t\t\t\t\t\ \ \ \ \ \ \ ]\), ";",
"\n",
StyleBox[\( (*\ Now\ create\ lattice\ *) \),
FontColor->RGBColor[1, 0, 0]], "\n", " ",
\(lattice = \ Map[#\ + \ curve&, offset]\), ";", "\n", " ",
\(AppendTo[lattice, \
lattice\[LeftDoubleBracket]1\[RightDoubleBracket]]\), ";",
" ", "lattice"}]}], " ", "\n", "\t\t", "]"}]}], ";"}]}]],
"Input",
CellLabel->"In[31]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Main functions gettube and getcolortube", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
RowBox[{
\(tube::bad = "\"\), ";", "\n",
"\n",
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
\(polygondata[lattice_, \ j_, i_] :=
\ {lattice\[LeftDoubleBracket]j, i\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j + 1, i\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j + 1, \ i + 1\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j, \ i + 1\[RightDoubleBracket]}\), ";",
"\n", "\n",
StyleBox[
\( (*\ These\ functions\ turn\ any\ bare\ color\ directives\ like\
Hue[0]\ into\ the\ graphics\ directive\
\(SurfaceColor[Hue[0]] . \)\ *) \),
FontColor->RGBColor[1, 0, 0]], "\n",
\(tosurf[x_] := \
If[Head[x]\ === \ RGBColor\ || \ Head[x]\ === \ Hue\ || \
Head[x]\ === \ CMYKColor, \ SurfaceColor[x], \ x]\), ";", "\n",
\(resolvecolors[directive_] := Map[tosurf, \ \ Flatten[{directive}]]\),
";", "\n", "\n",
RowBox[{
\(gettube[curve_, \ directive_, \ shapefun_, \ naround_, \ range_, \
helicity_, \ algo_]\), " ", ":=", " ",
RowBox[{"If", "[",
RowBox[{\(MatchQ[curve, \ curvedata]\), ",", " ", "\n", "\t\t",
RowBox[{"Module", "[",
RowBox[{
\({nalong\ = \ Length[curve], \ polylist, \ i, \ j, \ lattice,
\ sheaf}\), ",", " ", "\n", "\t\t\t",
RowBox[{
\(lattice\ = \
getlattice[curve, \ shapefun, \ naround, \ nalong, \
helicity, \ algo]\), ";", "\n", " ",
\(sheaf\ \ \ \ \ \ \ = \
Flatten[
Table[polygondata[\ lattice, \ j, i],
\ {i, \ 1, \ nalong - 1}, \ {j, \ 1, \ naround}], 1]
\), ";", "\n",
StyleBox[
\( (*\ If\ necessary, \ chop\ off\ unwanted\ polygons\ *)
\),
FontColor->RGBColor[1, 0, 0]], "\t", "\n", "\t\t\t",
\(polylist\ = \
If[NumberQ[range[{0, 0, 0}]], \ \ crop[sheaf, \ range], \
sheaf]\), ";", "\n",
StyleBox[
\( (*\ Turn\ into\ polygons; \
set\ default\ intrinsic\ color\ and\
\(reflectivity\ \ --\)\ then\ return\ a\ Graphics3D\
object\ *) \),
FontColor->RGBColor[1, 0, 0]], "\t", "\n", "\t\t\t",
\(polylist\ = \ Map[Polygon, \ polylist]\), ";", "\n",
"\t\t\t",
\(directiveplusreflectivity\ = \
Prepend[resolvecolors[directive],
SurfaceColor[Eggshell, \ GrayLevel[1], 15]]\), ";",
"\n", "\t\t\t",
\(Graphics3D[
FlattenAt[{directiveplusreflectivity, \ polylist}, \ 1]]
\)}]}], "\n", "\t\t\t", "]"}], ",", " ",
\(Message[tube::bad]\)}], "]"}]}], ";"}]], "Input",
CellLabel->"In[32]:=",
InitializationCell->True],
Cell[" Main program getcolortube for variable color directives ", "Text",
FontFamily->"Courier"],
Cell[BoxData[
RowBox[{
RowBox[{
StyleBox["(*",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
RowBox[{
StyleBox["This",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["version",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["of",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["polygondata",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["combines",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["a",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["list",
FontSlant->"Italic",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["of",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["graphics",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["directives",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["with",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["a",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["set",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["of",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["lattice",
FontColor->RGBColor[1, 0, 0]],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox[\(points . \),
FontColor->RGBColor[1, 0, 0]]}],
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
StyleBox["*)",
FontColor->RGBColor[1, 0, 0]]}], "\n",
RowBox[{
RowBox[{
\(colorpolygondata[directivetable_, \ lattice_, \ j_, i_]\), ":=",
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]], "\n",
\(FlattenAt[{\
resolvecolors[
directivetable\[LeftDoubleBracket]j, i
\[RightDoubleBracket]], {
lattice\[LeftDoubleBracket]j, i\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j + 1, i\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j + 1, \
i + 1\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j, \ i + 1\[RightDoubleBracket]}},
\ 1]\)}], ";", "\n", "\n",
RowBox[{
\(getcolortube[curve_, \ directive_, \ shapefun_, \ naround_, \
range_, \ helicity_, \ algo_]\), " ", ":=", " ",
RowBox[{"If", "[",
RowBox[{\(MatchQ[curve, \ curvedata]\), ",", " ", "\n", "\t\t",
RowBox[{"Module", "[",
RowBox[{
\({\ nalong\ = \ Length[curve], \ polylist, \ i, \ j, \
lattice, \ sheaf, \ colortable}\), ",", " ", "\n",
"\t\t",
RowBox[{
\(lattice\ = \
getlattice[curve, \ shapefun, \ naround, \ nalong, \
helicity, \ algo]\), ";", "\n", " ",
\(colortable\ =
todata[directive, \ naround, \ nalong]\), ";",
"\t\t\t", "\n", "\t ",
\(sheaf\ \ \ \ \ \ \ \ \ \ = \t
Flatten[
Table[colorpolygondata[colortable, \ lattice, \ j,
i], \ {i, \ 1, \ nalong - 1},
\ {j, \ 1, \ naround}], 1]\), ";", "\n",
StyleBox[
\( (*\ If\ necessary, \
chop\ off\ unwanted\ polygons\ *) \),
FontColor->RGBColor[1, 0, 0]], "\t", "\n", "\t\t\t",
\(polylist\ = \
If[NumberQ[range[{0, 0, 0}]], \ \
colorcrop[sheaf, \ range], \ \ sheaf]\), ";", "\n",
StyleBox[
\( (*\ Turn\ into\ polygons; \
set\ default\ intrinsic\ color\ and\
\(reflectivity\ \ --\)\ then\ return\ a\ Graphics3D
\ object\ *) \),
FontColor->RGBColor[1, 0, 0]], "\t", "\n", "\t",
\(polylist\ = \
Map[\ MapAt[Polygon, \ #, \ \(-1\)]&, \ polylist]\),
";", " ", "\n", "\t",
\(Graphics3D[
Join[{SurfaceColor[Eggshell, \ GrayLevel[1], 15]\ }, \
polylist]]\)}]}], "\n", "\t\t\t", "]"}], ",", " ",
\(Message[tube::bad]\)}], "]"}]}], ";"}]}]], "Input",
CellLabel->"In[33]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["User functions: tube, quicktube, checkedcurve", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(frenettube\ = \ 1; \ xytube\ = \ 2; \n
Options[tube] = {nalongtube \[Rule] 40, naroundtube \[Rule] 12,
tuberange \[Rule] All, tubehelicity \[Rule] 0,
tubealgorithm\ -> \ frenettube}; \ntubedefaults\ = \ Options[tube];
\n\ncheckedcurve[curve_, \ n_]\ := \ \
Which[\ MatchQ[curve, \ curvedata], curveinterp[curve, \ n], \n
\ \ \ \ \ \ \ VectorQ[N[curve[0]], \ NumberQ], todata[curve, n], \n
\t\tTrue, \ Null]; \n\n
tube[curve_, \ directive_, \ shapefun_, \ opts___] := \
gettube[checkedcurve[curve,
\(nalongtube /. {opts}\) /. Options[tube]\ ], directive, shapefun,
\n\t\t\ \ \(naroundtube\ \ \ \ /. {opts}\) /. Options[tube], \n
\ \ \ \ \ \ \ \ \
\(tuberange\ \ \ \ \ \ \ \ \ /. {opts}\) /. Options[tube], \n\t\ \ \t
\(tubehelicity\ \ \ /. {opts}\) /. Options[tube], \n
\ \ \ \ \ \ \ \ \ \(tubealgorithm\ /. {opts}\) /. Options[tube]\n
\ \ \ \ \ ]; \n\n
tube[curve_, \ directive_Symbol, \ shapefun_, \ opts___] := \
getcolortube[
checkedcurve[curve, \(nalongtube /. {opts}\) /. Options[tube]\ ],
directive, shapefun, \n\t\t\ \
\(naroundtube\ \ \ \ /. {opts}\) /. Options[tube], \n
\ \ \ \ \ \ \ \ \
\(tuberange\ \ \ \ \ \ \ \ \ /. {opts}\) /. Options[tube], \n\t\ \ \t
\(tubehelicity\ \ \ /. {opts}\) /. Options[tube], \n
\ \ \ \ \ \ \ \ \ \(tubealgorithm\ /. {opts}\) /. Options[tube]\n
\ \ \ \ \ ]; \n\n\
quicktube[curve_] :=
Show[tube[curve, Eggshell, \ 1], \ Boxed -> \ False]; \)], "Input",
CellLabel->"In[34]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["User functions: fluxlines", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(getlonglines[tubeobject_, \ nlonglines_, \ naround_, \ nalong_] := \n
Module[{polylist, \ toomanylines, \ i, \ j}, \
polylist\ = \(tubeobject\ // First\) // Last; \n\t\t\t\t\t\t\
toomanylines\ = \
polylist /. \
Polygon[{a_, \ b_, \ c_, \ d_}]\ \ -> \ Line[{a, d}]; \n
\t\t\t\t\t\t\t\t\t\t
Flatten[\
Table[toomanylines
\[LeftDoubleBracket]\((i\ \ naround + 1)\)\ + \
j\ naround/\ nlonglines\[RightDoubleBracket],
\ {i, 0, \ nalong - 2}, {j, \ 0, \ \ nlonglines - 1}], 1]\n\t]; \n
\ngetshortlines[tubeobject_, \ nshortlines_, \ \ naround_, \ nalong_] :=
\n\tModule[{polylist, \ toomanylines, \ i, \ j}, \
polylist\ = \(tubeobject // First\) // Last\ ; \n\t\t\t\t\t\t\
toomanylines\ = \
polylist /. \
Polygon[{a_, \ b_, \ c_, \ d_}]\ \ -> \ Line[{a, b}]; \n
\t\t\t\t\t\t\t\t\t\t
Flatten[\
Table[toomanylines
\[LeftDoubleBracket]i\ \ + \
j\ \((nalong - 1)\)\
naround/nshortlines\[RightDoubleBracket],
\ {i, \ 1, \ naround}, {j, \ 0, \ nshortlines - 1}], 1]\n\t]; \n
\t\t\t\t\t\t\t\t\t\t\n
getflux[curve_, \ radius_, \ nlonglines_, \ nshortlines_, \
fluxthickness_, \ fluxcolor_] :=
Module[{newtube, \ lines, naround, nalong}, \n\t\t\t\t
naround\ = naroundtube /. Options[tube, \ naroundtube]\ ;
nalong\ = nalongtube /. \ Options[tube, \ nalongtube]; \ \n\t\t\t\
naround\ = \ Ceiling[naround/nlonglines]\ nlonglines; \n\t\t\t
nalong\ = \ 1 + Ceiling[\((nalong - 1)\)/nshortlines]\ nshortlines;
\n\t\tnewtube =
tube[curve, \ White, \ radius, \ naroundtube\ -> naround, \
nalongtube -> nalong]; \n
\t\t\t\t\t\t\t{
Graphics3D[
\ {Thickness[fluxthickness], fluxcolor, \
getlonglines[newtube, \ \ \ nlonglines, \ naround, \ nalong]
\ }], \n\t\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
Graphics3D[
\ {Thickness[fluxthickness], fluxcolor,
getshortlines[newtube, nshortlines, \ naround, \ nalong]\ }\ ]\n
\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ }]; \t\t\t\n\n
Options[fluxlines] = {fluxthickness -> 0.005,
fluxcolor -> \ \ GrayLevel[0]}; \n\n
fluxlines[curve1_, \ radius_, \ nlonglines_, \ nshortlines_, \
opts___] := \n\ \ \ \ \ \
getflux[\ curve1, \ radius, \ nlonglines, \ nshortlines, \ \n\t\t
\(fluxthickness /. {opts}\) /. Options[fluxlines], \n\t\t
\(fluxcolor /. {opts}\) /. Options[fluxlines]\ ]; \t\t\t\ \)\)],
"Input",
CellLabel->"In[35]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Main function getarrow", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(\(getarrow[pp_, \ qq_, \ normal_, \ thickness_]\ := \
Module[{a, b, c, d, e, f, g, nhat, len, \ thick, \ sticklength, \
trilength, hwidth, \n\t\t\ttop, \ bot, \ bottom, \ side1, side2, \
wing1, \ wing2, \ back1, \ back2}, \ \n\t\tw\ \ \ \ \ = qq - pp; \
\n\t\tlen\ = \ \ N[Sqrt[w . w]]; \n\t\t\ w\ \ \ \ = \ N[w/len]; \n
\t\t\ nhat\ = \
N[Cross[w, \ Cross[normal, \ w]]/Sqrt[normal . normal]]; \ \n
\t\ \ \ v\ = \ Cross[nhat, \ w]; \n\t\tsticklength\ = \ len/2; \n
\t\ttrilength\ = \ len\ - \ sticklength; \n\t\t
hwidth\ = \ sticklength/6; \n\t\tthick\ \ = \ thickness\ len; \n
\t\t (*\ top\ \ of\ arrow\ *) \n\t\ta\ = \ pp\ + \ hwidth\ v;
b\ = \ pp\ - \ hwidth\ v; c\ = \ b\ + \ sticklength\ w;
g\ = \ a\ + \ sticklength\ w; \n\t\td = \ c\ - \ \ \ hwidth\ v;
e\ = \ qq; \n\t\tf = \ g\ + hwidth\ v; \n
\t\t (*\ bottom\ of\ arrow\ *) \n\t\ \ \
bot[{x_, y_, z_}]\ := \ {x, y, z}\ - \ thick\ nhat; \n\t\t
top\ = \ {a, b, c, g}; arrowtop\ = \ {d, \ e, f}; \
bottom\ = \ Map[bot, \ top]; \
arrowbottom\ = \ Map[bot, \ arrowtop]; \
end\ = \ {a, b, bot[b], \ bot[a]}; \n\t\t
side1\ \ = \ {b, c, \ bot[c], \ bot[b]}; \ \t
side2\ \ = \ {g, a, \ bot[a], \ bot[g]}; \n\t\t
wing1\ \ = \ {d, e, \ bot[e], \ bot[d]}; \ \t
wing2\ \ = \ {e, f, \ bot[f], \ bot[e]}; \ \n\t\t
back1\ \ = \ {d, c, \ bot[c], \ bot[d]}; \ \t
back2\ \ = \ {g, f, \ bot[f], \ bot[g]}; \n\t\t\
polly\ =
\ {\ top, \ arrowtop, \ bottom, \ arrowbottom, \ end, \ side1, \
side2, \ wing1, \ wing2, \ back1, \ back2}; \n\t\t
Map[Polygon, polly]]; \)\n\t\t\)\)], "Input",
CellLabel->"In[36]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["User functions: arrow, sidearrow", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(Options[arrow]\ =
\ {arrowcolor\ -> \ Red, arrowthickness\ \ -> 0.1}; \n\
showarrow[p_, q_, n_, color_, \ thickness_]\ := \n\t\t\
Graphics3D[{EdgeForm[], SurfaceColor[color, GrayLevel[1.0], \ 15],
getarrow[p, q, n, thickness]}]; \n\n
arrow[p_, q_, n_, opts___]\ := \
showarrow[p, q, n, \(arrowcolor\ /. {opts}\) /. Options[arrow], \ \n
\t\t\(arrowthickness\ \ \ \ /. {opts}\) /. Options[arrow]]; \)],
"Input",
CellLabel->"In[37]:=",
InitializationCell->True],
Cell[BoxData[
\(Options[sidearrow]\ =
\ {arrowcolor\ -> Red, arrowthickness\ \ -> 0.1}; \n
sidearrow[fun_, \ t_, \ eps_, \ radius_, \ theta_, opts___]\ := \
Module[{ppp, \ qqq, \ norm, \ a, \ b, \ qp, \ woof, view, off}, \n\t\t
a\ = \ fun[t]; \ \n\t\tb\ = \ fun[Mod[t + eps, \ 1]]; \n\t\t
len\ = \ Sqrt[\((b - a)\) . \((b - a)\)]; \n\t\t
qp\ = \ \((b - a)\)/len; \n\t\t
woof\ = \ Options[Graphics3D, \ ViewPoint]; \n\t\t
view\ = \ ViewPoint\ /. \ woof; \n\t\tnorm\ = \ normalize[view]; \n
\t\tnorm\ = Cross[qp, \ Cross[norm, \ qp]]; \n\t\t
binorm\ = \ Cross[norm, \ qp]; \t\ \ \
off\ = \((radius\ + \ 0.1\ len)\)*\
\(rotate[{norm, \ binorm}, \ theta]\)\[LeftDoubleBracket]1
\[RightDoubleBracket]; \n\t\tppp\ = \ a\ + \ off; \n\t\t
qqq\ = \ b\ + \ off; \n\t\t
showarrow[ppp, qqq, off, \
\(arrowcolor\ /. {opts}\) /. Options[sidearrow], \ \n\t\t
\(arrowthickness\ \ \ \ /. {opts}\) /. Options[sidearrow]]]; \)],
"Input",
CellLabel->"In[38]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["User Functions: tress", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(boundingbox[braid_] := \
Module[{pts, \ nz, \ nc, \ i}, nc = Length[braid]; \n\t\t\t
nz = Length[braid\[LeftDoubleBracket]1\[RightDoubleBracket]]; \ \ \n
\t\tpts =
Transpose[
Join[Table[braid\[LeftDoubleBracket]i, 1\[RightDoubleBracket],
\ {i, nc}],
Table[braid\[LeftDoubleBracket]i, nz\[RightDoubleBracket],
\ {i, nc}]]]; \n\t\t{Map[Min, \ pts], \ Map[Max, pts]}]; \n\n
pedestal[box_, \ \ thick_, \ margin_] := \ \
Module[{left, \ right, \ front, \ back, \ bot, \ top}, \ \n\t\t\t
left = \ box\[LeftDoubleBracket]1, 1\[RightDoubleBracket] - margin; \
right = box\[LeftDoubleBracket]2, 1\[RightDoubleBracket] + margin; \
bot = box\[LeftDoubleBracket]1, 3\[RightDoubleBracket];
tresswidth = right; \n\t\t
front = \ box\[LeftDoubleBracket]1, 2\[RightDoubleBracket] - margin;
\ back = box\[LeftDoubleBracket]2, 2\[RightDoubleBracket] + margin; \
top\ = \ box\[LeftDoubleBracket]2, 3\[RightDoubleBracket]; \ \n
\ \ \ \ \ \t{
Graphics3D[
Cuboid[{left, \ front, bot\ - \ thick/2},
\ {right, \ back, \ bot + thick/2}]],
Graphics3D[
Cuboid[{left, \ front, top\ - \ thick/2},
\ {right, \ back, top + \ thick/2}]]}]; \)], "Input",
CellLabel->"In[39]:=",
InitializationCell->True],
Cell[BoxData[
\(\(braidtubes[braid_, \ colors_, \ radius_, \ braidrange_] :=
Table[\n\t\t
tube[braid\[LeftDoubleBracket]i\[RightDoubleBracket],
\t{EdgeForm[], \
colors\[LeftDoubleBracket]Mod[i - 1, \ \ Length[colors]] + 1
\[RightDoubleBracket]}, radius, \ tuberange\ -> \ braidrange]
\ , \n\t\t\ \ \ {i, \ 1, \ Length[braid]}]; \)\)], "Input",
CellLabel->"In[40]:=",
InitializationCell->True],
Cell[BoxData[
\(\(nicecolors = {RGBColor[1, \ 0, \ 0], RGBColor[0, 1, \ 1],
RGBColor[1, \ 1, \ 0], RGBColor[0, 1, \ 0], \n\t\t
RGBColor[1, \ 0, \ 1], \ RGBColor[0, \ 0, \ 1], \
RGBColor[1, \ 0.5, \ 0.5], RGBColor[1, \ 0.5, \ 0],
RGBColor[0, \ 1, \ 0.5], RGBColor[1, \ 0, \ 0.5],
RGBColor[0.5, \ 0, 1], RGBColor[0.25, \ 0.5, \ 0.5]}; \)\)], "Input",
CellLabel->"In[41]:=",
InitializationCell->True],
Cell[BoxData[
\(Options[tress]\ =
\ {braidcolors\ -> nicecolors, \ pedestal\ -> \ {4, \ 0.75}}; \n\n
tress[curvelist_, radius_, \ opts___]\ :=
Module[{colors, braidlist, ped, \ margin, \ thick, \ box, braidrange,
i}, \ \n\t\
colors\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ = \
\(braidcolors\ /. \ {opts}\)\ /. \ Options[tress]; \n\t\
braidlist =
Table[checkedcurve[
curvelist\[LeftDoubleBracket]i\[RightDoubleBracket],
nalongtube /. Options[tube]], {i, 1, Length[curvelist]}]; \n\t\
ped\ = \ \(pedestal\ /. \ {opts}\)\ /. \ Options[tress]; \n\t\
ped\ = \ ped\ *\ If[NumberQ[radius], \ radius, \ radius[0, 0]]; \n
\t\tmargin\ = \ ped\[LeftDoubleBracket]1\[RightDoubleBracket]\ ; \n
\t\tthick\ \ \ \ \ = \
ped\[LeftDoubleBracket]2\[RightDoubleBracket]; \n\t\t
box = boundingbox[braidlist]; \
tresswidth\ = \
box\ \[LeftDoubleBracket]2, 1\[RightDoubleBracket]\ - \
box\ \[LeftDoubleBracket]1, 1\[RightDoubleBracket]; \n\t\t
braidrange[vec_]\ := \
If[vec\[LeftDoubleBracket]3\[RightDoubleBracket] >= \
box\ \[LeftDoubleBracket]1, 3\[RightDoubleBracket]\ && \
vec\[LeftDoubleBracket]3\[RightDoubleBracket] <= \
box\ \[LeftDoubleBracket]2, 3\[RightDoubleBracket], \ 1, \
\(-1\)]; \n\t\t
graphicslist = \
Flatten[{pedestal[box, \ thick, \ margin],
braidtubes[braidlist, colors, \ radius, \ braidrange]}]; \n\t\t
Graphics3D[
Table[graphicslist\[LeftDoubleBracket]i, 1\[RightDoubleBracket],
\ {i, \ 1, \ Length[graphicslist]}], \ PlotRange -> All\ ]\n\t];
\)], "Input",
CellLabel->"In[42]:=",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[BoxData[
\(End[\ ]; \ EndPackage[\ ]; \ On[General::spell1]\)], "Input",
CellLabel->"In[43]:=",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[TextData[{
"Tubafunctions \n",
StyleBox[
"(June 1999) by M A Berger, Mathematics, University College London",
FontSize->12,
FontColor->GrayLevel[0]]
}], "Section",
InitializationCell->True,
FontFamily->"Courier",
FontSize->24,
FontColor->RGBColor[0, 0, 1]],
Cell[BoxData[
\(BeginPackage["\"]; \ \ Needs["\"]; \
Off[General::spell1]; \)], "Input",
CellLabel->"In[44]:=",
InitializationCell->True],
Cell[CellGroupData[{
Cell["Usage Messages", "Section",
InitializationCell->True,
FontFamily->"Courier"],
Cell[CellGroupData[{
Cell["arch", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(arch::usage =
"\ range for \
the tube graphics routine.\>"; \)\)], "Input",
CellLabel->"In[45]:=",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell["artin", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(artin::usage\ = \
\*"\"\\""; \)\)], "Input",
CellLabel->"In[46]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["scaledbraid", "Subsubsection",
InitializationCell->True,
FormatType->TextForm,
FontFamily->"Courier"],
Cell[BoxData[
\(\(scaledbraid::usage = "\<
scaledbraid[braid, xyscale, n] first converts braid to a set of lists of \
length n.
It then chooses z values so that the ith point in the list for each curve \
is at z=i-1. \>"; \)\)], "Input",
CellLabel->"In[47]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["readcurves, writecurves", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell["\<\
readcurves::usage =
\"readcurves[\\\"tiger.dat\\\", ncurves] will read a data file called \
tiger.dat . This file should contain nz*ncurves lines, where each line has \
three floating point numbers ({x,y,z} coordinates). The top nz lines
describe curve 1, and so on. readcurves[\\\"tiger.dat\\\"] assumes that the \
first line consists of the two numbers ncurves, nz.\";
writecurves::usage =
\"writecurves[\\\"tiger.dat\\\", curves] will write out the coordinates in \
the list curves to the file
tiger.dat. The first lines gives the number of curves and the number of \
points per curve nz. After this will each line gives a point as three \
floating point numbers ({x,y,z} coordinates). The top nz points describe \
curve 1, and so on.\";\
\>", "Input",
CellLabel->"In[48]:=",
InitializationCell->True,
FormatType->TextForm,
FontFamily->"Courier"]
}, Open ]],
Cell[CellGroupData[{
Cell["torusknot", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(torusknot::usage\ = \ \n\
"\"; \)\)], "Input",
CellLabel->"In[50]:=",
InitializationCell->True]
}, Open ]]
}, Closed]],
Cell[CellGroupData[{
Cell["Code", "Section",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(Begin["\<`Private`\>"]; \)\)], "Input",
CellLabel->"In[51]:=",
InitializationCell->True],
Cell[CellGroupData[{
Cell["arch", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(arch[{x1_, \ y1_}, \ {x2_, \ y2_}, \ t_]\ := \
Module[{u, \ uhat, \ mu, \ distance, \ \ midpoint}, \n\t\t
u\ = \ {x2 - x1, \ y2 - y1, \ 0}; \n\t\tdistance\ = \ Sqrt[u . u];
\n\t\tuhat\ = \ u/distance; \n\t\t
midpoint\ = \ \(({x1, \ y1, \ 0}\ + \ {x2, \ y2, \ 0})\)/2; \n\t\t
mu\ = \ Pi\ \((t - 1/2)\); \n\t\t
N[midpoint\ + \
distance\ \((Sin[mu]\ uhat\ + \ Cos[mu]\ {0, 0, 1})\)/2]\n];
\)\)], "Input",
CellLabel->"In[52]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["artin", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(Clear[artin]\)], "Input",
CellLabel->"In[53]:=",
InitializationCell->True],
Cell[BoxData[
\(artin[braidword_, \ nstrings_, \ deltaz_]\ := \
If[VectorQ[braidword, \ IntegerQ], \
Module[{nsigmas\ = \ Length[braidword], \ stringposn, \ sig, \ mu, \
h, \ braid, \ j, \ iz}, \ stringposn\ = \ Range[nstrings]; \ \
braid\ = \ Table[{{j, 0, 0}}, \ {j, nstrings}]; \ \n\t\t\t
Do[{\n\t\t
sig\ = Abs[
braidword\[LeftDoubleBracket]iz\[RightDoubleBracket]],
mu\ = \ Sign[
braidword\[LeftDoubleBracket]iz\[RightDoubleBracket]], \n
\t\t\t\t\t
If[0 < sig < nstrings, {\n\t\t\t\t\t
h = \ \((iz - 0.5)\) deltaz, \
braid = \
braidappend[braid, \ \n\t\t\t\t\t\t
simplebraid[nstrings, \ stringposn, \ sig, \ mu, \n
\t\t\t\t\t\t\t\ h]],
stringposn = flip[stringposn, \ sig],
If[iz < nsigmas, \
If[braidword\[LeftDoubleBracket]iz
\[RightDoubleBracket] ==
braidword
\[LeftDoubleBracket]iz + 1\[RightDoubleBracket], \n
\t\t\t\t\t\t\t\t\t
braid = \
braidappend[braid, \ \
Table[{
stringposn\[LeftDoubleBracket]j
\[RightDoubleBracket], 0, iz\ deltaz},
\ {j, nstrings}]]\n\t\t\t\t\t\t\t\t]]\n\ }]\n
\t\t\t\t\ \ \ }, {iz, \ nsigmas}]; \n\t\t\t
If[nsigmas\ == 0, h = 1, \ h = nsigmas*deltaz]; \
braidappend[braid, \ \
Table[{stringposn\[LeftDoubleBracket]j\[RightDoubleBracket], 0,
h}, \ {j, nstrings}]]\n\t\t], \
Print["\"]]; \n
artin[braidword_, \ nstrings_] := \ artin[braidword, \ nstrings, \ 1];
\)], "Input",
CellLabel->"In[54]:=",
InitializationCell->True],
Cell[BoxData[
\(flip[perm_, \ s_]\ :=
If[0 < s < Length[perm], \ \
Module[{new, \ leftstring, \ rightstring}, \ \n\t\t\t
leftstring\ \ =
\(Position[perm, \ s]\)\[LeftDoubleBracket]1, 1
\[RightDoubleBracket]; \n\t\t\t
rightstring =
\(Position[perm, \ s + 1]\)\[LeftDoubleBracket]1, 1
\[RightDoubleBracket]; \n\t\t\t
new\ = \ ReplacePart[perm, \ s + 1, \ leftstring]; \n\t\t\t
ReplacePart[new, \ s, \ rightstring]]\n\t]; \ \n
braidcat[botbraid_, \ topbraid_]\ := \
MapThread[Join, \ {botbraid, \ topbraid}]; \n
braidappend[braid_, \ points_]\ := \
MapThread[Append, \ {braid, \ points}]; \)], "Input",
CellLabel->"In[55]:=",
InitializationCell->True],
Cell[BoxData[
\(\(\(simplebraid[nstrings_, perm_, \ s_, \ mu_, h_] :=
If[0 < s < Length[perm], \ \
Module[{nextlevel, \ leftstring, \ rightstring, \ j}, \ \n\t\t\t
leftstring\ \ =
\(Position[perm, \ s]\)\[LeftDoubleBracket]1, 1
\[RightDoubleBracket]; \n\t\t\t
rightstring =
\(Position[perm, \ s + 1]\)\[LeftDoubleBracket]1, 1
\[RightDoubleBracket]; \n\t\t
nextlevel\ \ \ \ \ = \
Table[{perm\[LeftDoubleBracket]j\[RightDoubleBracket], 0, h},
\ {j, nstrings}]; \n\t\t
nextlevel\ \ \ \ \ = \
ReplacePart[nextlevel, {s + 0.5, \ \(-0.5\) mu, \ h}\ ,
leftstring]; \ \t\n\t\t
ReplacePart[nextlevel, \ {s + 0.5, \ \ 0.5 mu, \ h}, rightstring]
\ ], \n\t\t]; \)\n\t\t\)\)], "Input",
CellLabel->"In[56]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["scaledbraid", "Subsubsection",
InitializationCell->True,
FormatType->TextForm,
FontFamily->"Courier"],
Cell[TextData[
"scaledbraid[braid_, xyscale_, n_] := Module[{ncurves = Length[braid], \
tempbraid, jcurve, ipoint}, tempbraid = Map[checkedcurve[#, n]&, braid]; \n\
Table[{xyscale tempbraid\[LeftDoubleBracket]jcurve, ipoint, 1\
\[RightDoubleBracket],\n xyscale tempbraid\[LeftDoubleBracket]jcurve, \
ipoint, 2\[RightDoubleBracket], ipoint-1}, \n\t\t\t{jcurve, ncurves}, \
{ipoint,n}]];\t"], "Input",
CellLabel->"In[57]:=",
InitializationCell->True,
FormatType->TextForm,
FontFamily->"Courier"]
}, Closed]],
Cell[CellGroupData[{
Cell["readcurves, writecurves", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[TextData[
"readcurves[file_, ncurves_] := Module[{nz, intnz, data}, data = \
ReadList[file, Number, RecordLists -> True]; nz = Length[data]/ncurves; intnz \
= IntegerPart[nz]; If[Not[nz==intnz], {nz=intnz, Print[\"Warning! Length of \
data set not an integer multiple of number of curves.\"]}]; Table[Take[data, \
{(i-1)nz + 1, i*nz}], {i, ncurves}] ];\n\nreadcurves[file_] := \
Module[{ncurves, nz, data, i}, data = ReadList[file, Number, RecordLists -> \
True]; \n\t\tncurves = data\[LeftDoubleBracket]1, 1\[RightDoubleBracket];\n\t\
\tnz = data\[LeftDoubleBracket]1, 2\[RightDoubleBracket]; \n\t\tntest = \
(Length[data]-1)/ncurves; If[Not[nz+1==ntest], Print[\"Warning! Length of \
data set not equal to (nz+1)*ncurves from first line of file! \"]]; \
Table[Take[data, {(i-1)(nz+1) + 2, i*(nz+1) + 1}], {i, ncurves}] ];\n\n\
writecurves[file_,curves_]:= Module[{t, ncurves=Length[curves], \nnz = \
Length[ curves\[LeftDoubleBracket]1\[RightDoubleBracket]]-1, icurve, ipoint}, \
t = OpenWrite[file, FormatType -> OutputForm];\n\t\tWrite[t, ncurves,\" \", \
nz];\nDo[Do[Write[t,curves\[LeftDoubleBracket]icurve, ipoint, 1\
\[RightDoubleBracket],\" \",\ncurves\[LeftDoubleBracket]icurve, ipoint, 2\
\[RightDoubleBracket],\" \",\ncurves\[LeftDoubleBracket]icurve, ipoint, 3\
\[RightDoubleBracket]], {ipoint, 1, nz+1}], {icurve,ncurves}];\nClose[t];\n\
];"], "Input",
CellLabel->"In[58]:=",
InitializationCell->True,
FormatType->TextForm,
FontFamily->"Courier"]
}, Closed]],
Cell[CellGroupData[{
Cell["torusknot", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(torusknot[p_, \ q_, \ majorradius_, \ minorradius_, \ t_]\ := \
Module[{ax, \ az, \ circ, \ offset}, \n\t\tax\ = \ 2\ Pi\ p\ t; \ \n
\t\taz\ = \ 2\ Pi\ q\ t; \n\t\t
circ\ = \ majorradius\ {Cos[ax], \ Sin[ax], \ 0}; \n\t\t\t
offset\ = \
minorradius
\(({Cos[ax] Cos[az], Sin[ax] Cos[az], \ \(-Sin[az]\)})\); \ \n\t\t
circ\ + \ offset]; \)\)], "Input",
CellLabel->"In[61]:=",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[BoxData[
\(End[\ ]; \ EndPackage[\ ]; \ On[General::spell1]; \)], "Input",
CellLabel->"In[62]:=",
InitializationCell->True]
}, Closed]]
},
FrontEndVersion->"Microsoft Windows 3.0",
ScreenRectangle->{{0, 1280}, {0, 968}},
AutoGeneratedPackage->Automatic,
WindowToolbars->"EditBar",
CellGrouping->Manual,
WindowSize->{1142, 649},
WindowMargins->{{-8, Automatic}, {Automatic, 65}},
Magnification->1.25,
StyleDefinitions -> "Textbook.nb"
]
(***********************************************************************
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[CellGroupData[{
Cell[1731, 51, 282, 10, 132, "Section",
InitializationCell->True],
Cell[2016, 63, 281, 7, 56, "Input",
InitializationCell->True],
Cell[2300, 72, 175, 4, 35, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[2500, 80, 86, 2, 106, "Section",
InitializationCell->True],
Cell[CellGroupData[{
Cell[2611, 86, 128, 2, 44, "Subsubsection",
InitializationCell->True],
Cell[2742, 90, 811, 16, 329, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[3590, 111, 108, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[3701, 115, 2445, 34, 708, "Input",
InitializationCell->True],
Cell[6149, 151, 492, 12, 199, "Input",
InitializationCell->True],
Cell[6644, 165, 531, 10, 119, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[7212, 180, 87, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[7302, 184, 529, 11, 140, "Input",
InitializationCell->True],
Cell[7834, 197, 203, 4, 56, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[8074, 206, 94, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[8171, 210, 1143, 24, 392, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[9351, 239, 83, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[9437, 243, 984, 20, 314, "Input",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[10470, 269, 76, 2, 62, "Section",
InitializationCell->True],
Cell[10549, 273, 114, 3, 35, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[10688, 280, 104, 2, 44, "Subsubsection",
InitializationCell->True],
Cell[10795, 284, 159, 4, 35, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[10991, 293, 132, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[11126, 297, 1300, 25, 329, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[12463, 327, 97, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[12563, 331, 3804, 69, 371, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[16404, 405, 158, 4, 33, "Subsubsection",
InitializationCell->True],
Cell[16565, 411, 2723, 57, 413, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[19325, 473, 136, 3, 33, "Subsubsection",
InitializationCell->True],
Cell[19464, 478, 1918, 37, 308, "Input",
InitializationCell->True],
Cell[21385, 517, 3990, 79, 476, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[25412, 601, 117, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[25532, 605, 3285, 66, 434, "Input",
InitializationCell->True],
Cell[28820, 673, 98, 1, 29, "Text"],
Cell[28921, 676, 5619, 135, 413, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[34577, 816, 123, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[34703, 820, 1692, 31, 539, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[36432, 856, 103, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[36538, 860, 2814, 55, 623, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[39389, 920, 100, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[39492, 924, 1891, 32, 560, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[41420, 961, 110, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[41533, 965, 541, 11, 140, "Input",
InitializationCell->True],
Cell[42077, 978, 1147, 21, 329, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[43261, 1004, 99, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[43363, 1008, 1446, 27, 224, "Input",
InitializationCell->True],
Cell[44812, 1037, 466, 9, 77, "Input",
InitializationCell->True],
Cell[45281, 1048, 449, 8, 77, "Input",
InitializationCell->True],
Cell[45733, 1058, 1861, 35, 308, "Input",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[47621, 1097, 134, 3, 27, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[47792, 1105, 283, 10, 132, "Section",
InitializationCell->True],
Cell[48078, 1117, 183, 4, 35, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[48286, 1125, 86, 2, 106, "Section",
InitializationCell->True],
Cell[CellGroupData[{
Cell[48397, 1131, 82, 2, 44, "Subsubsection",
InitializationCell->True],
Cell[48482, 1135, 443, 8, 98, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[48962, 1148, 83, 2, 44, "Subsubsection",
InitializationCell->True],
Cell[49048, 1152, 528, 9, 120, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[49613, 1166, 113, 3, 33, "Subsubsection",
InitializationCell->True],
Cell[49729, 1171, 299, 7, 77, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[50065, 1183, 101, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[50169, 1187, 872, 18, 205, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[51078, 1210, 87, 2, 44, "Subsubsection",
InitializationCell->True],
Cell[51168, 1214, 414, 8, 119, "Input",
InitializationCell->True]
}, Open ]]
}, Closed]],
Cell[CellGroupData[{
Cell[51631, 1228, 76, 2, 62, "Section",
InitializationCell->True],
Cell[51710, 1232, 114, 3, 35, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[51849, 1239, 82, 2, 44, "Subsubsection",
InitializationCell->True],
Cell[51934, 1243, 551, 11, 182, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[52522, 1259, 83, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[52608, 1263, 98, 3, 35, "Input",
InitializationCell->True],
Cell[52709, 1268, 2059, 40, 350, "Input",
InitializationCell->True],
Cell[54771, 1310, 793, 17, 182, "Input",
InitializationCell->True],
Cell[55567, 1329, 921, 19, 203, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[56525, 1353, 113, 3, 33, "Subsubsection",
InitializationCell->True],
Cell[56641, 1358, 508, 10, 110, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[57186, 1373, 101, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[57290, 1377, 1476, 23, 395, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[58803, 1405, 87, 2, 33, "Subsubsection",
InitializationCell->True],
Cell[58893, 1409, 493, 10, 140, "Input",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[59413, 1423, 136, 3, 27, "Input",
InitializationCell->True]
}, Closed]]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)