(************** Content-type: application/mathematica **************
CreatedBy='Mathematica 5.0'
Mathematica-Compatible Notebook
This notebook can be used with any Mathematica-compatible
application, such as Mathematica, MathReader or Publicon. The data
for the notebook starts with the line containing stars above.
To get the notebook into a Mathematica-compatible application, do
one of the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the
application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing
the word CacheID, otherwise Mathematica-compatible applications may
try to use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
*******************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 85239, 1960]*)
(*NotebookOutlinePosition[ 86024, 1987]*)
(* CellTagsIndexPosition[ 85980, 1983]*)
(*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[88]:=",
InitializationCell->True],
Cell[BoxData[
\(BeginPackage["\", \ "\"]; \
Off[General::spell1];\)], "Input",
CellLabel->"In[89]:=",
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\ "\";\)\), "\n",
\(\(rotate::usage\ = \ \n\ "\";\)\), "\n",
\(\(curveinterp::usage\ = \ \n\ "\";\)\), "\n",
\(\(todata::usage\ = \n"\";\)\), "\n",
\(\(slidebraid::usage = "\";\)\), "\n",
\(\(getnormals::usage\ = \ "\";\)\)}], "Input",
CellLabel->"In[90]:=",
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\tThe \
default algorithm creates a 'zero twist framing' (except for a small \
correction, which can be turned off, for any rotational transform present in \
closed curves). For a frenettube, 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\t\
1. 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. \
twistnumber -> hh will add hh units of twist (in units of 2\[Pi] radians). \
The standard tubealgorithm has twist number 0. \n 5. alignedtube -> \
True adds a small amount of twist to closed curves in order to make the \
longitudinal lines align at t=0 and t=1 (overcoming any rotational transform \
present). The amount added is at most \[Pi]/aroundtube.\n \t 6. \
tubealgorithm -> standardtube (default) gives a tube where the lines parallel \
to the axis have zero twist number (a small twist will be added to closed \
curves under option alignedtube -> True).\n tubealgorithm -> \
frenettube uses normal and binormal for circles perpendicular to curve.\n \
tubealgorithm -> xytube will plot circles perpendicular to curve in xy \
plane.\n tubealgorithm -> {a,b,c} gets normal by crossing tangent \
with fixed vector {a,b,c}.\>\"";\)\)], "Input",
CellLabel->"In[96]:=",
InitializationCell->True],
Cell["\<\
tubedefaults::usage = \"default tube options\";
tuberange::usage= \"tube option\";
twistnumber::usage =\"tube option, default = 0\";
tubealgorithm::usage = \"tube option which gives framing of tube, default = \
standardtube (or 0).
Options: For Frenet normal and binormal use frenettube (or 1).(xytube = \
2)\";
naroundtube::usage = \"tube option, default = 12\";
nalongtube::usage = \"tube option, default = 40 \";
standardtube::usage = \"tubealgorithm option ( = 0)\";
frenettube::usage = \"tubalgorithm option ( = 1)\";
xytube::usage = \"tubealgorithm option ( = 2)\";
alignedtube::usage = \"tubealgorithm option (default = True)\";\
\>", "Input",
CellLabel->"In[97]:=",
InitializationCell->True],
Cell[BoxData[{
\(\(quicktube::usage\ = \ "\";\)\), "\n",
\(\(checkedcurve::usage\ = \ "\";\)\)}], "Input",
CellLabel->"In[105]:=",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell["povray", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(topovray::usage\ = "\";\)\)], "Input",
CellLabel->"In[109]:=",
InitializationCell->True],
Cell[BoxData[
\(\(povappend::usage\ = "\";\)\)], "Input",
CellLabel->"In[109]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["fluxlines, fluxcurves", "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]).\>";\)\), "\n",
\(\(fluxcurves::usage\ = \ "\";\)\)}], \
"Input",
CellLabel->"In[107]:=",
InitializationCell->True],
Cell[BoxData[{
\(\(fluxthickness::usage\ = \ \ "\";\)\), "\n",
\(\(fluxcolor::usage\ = \ \ "\ ";\)\)}], "Input",
CellLabel->"In[109]:=",
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);
\>";\)\), "\n",
\(\(sidearrow::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[111]:=",
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, radius, pedestal] 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[115]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["extras: plaitlist, intrinsics", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(plaitlist::usage = "\";\)\)], "Input",
CellLabel->"In[120]:=",
InitializationCell->True],
Cell[BoxData[
\(\(intrinsics::usage = "\ 37] if you wish \
37 points.\>";\)\)], "Input",
CellLabel->"In[121]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["extras: gltress, slidebraid, satellites", "Subsubsection",
InitializationCell->True],
Cell["\<\
slidebraid::usage = \"slidebraid[braid, a] slides braid to right by a. Use as \
in
doubletress[thisbraid_, thatbraid_] := {gltress[thisbraid, 1], \
gltress[slidebraid[thatbraid, 1.1 tresswidth], 1]}\";
gltress::usage = \"gltress[braid, radius, plinth] is just like tress only \
tuberange is not used to cut tops off the tubes.\";
satellites::usage = \"satellites[curve, radius, nlonglines]gives a list of \
curves which, like fluxlines, follow the lattice on the tube. Here they are \
returned as lists of points.\";\
\>", "Input",
CellLabel->"In[122]:=",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["Code", "Section",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(Begin["\<`Private`\>"];\)\)], "Input",
CellLabel->"In[125]:=",
InitializationCell->True],
Cell[CellGroupData[{
Cell["Basic Data Type: curvedata", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(curvedata\ = \
x : {{_?NumericQ, _?NumericQ, _?NumericQ} .. };\)\)], "Input",
CellLabel->"In[126]:=",
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]]\), "\n",
\(\(rotate[v_, \
theta_]\ := \ {{Cos[theta], \ Sin[theta]}, {\(-Sin[theta]\), \
Cos[theta]}}\ . \ v;\)\), "\n",
\(curveinterp[curve_, \ ncurve_]\ := \
Module[\n\t\t{tran, \ inter, \ t, \ morepoints, \ npoints, \
interporder, \ i}, \
tran\ = \ Transpose[curve]; \ \n\t\tnpoints\ = \ Length[curve];
interporder\ = \
If[npoints > 3, 3, npoints - 1]; \n\t\t\ inter\ = \
Map[Interpolation[#, \ InterpolationOrder -> interporder] &, \
tran]; \ \n\t\tt[i_]\ := \
N[\((i - 1)\) \((npoints\ - \ 1)\)/\((ncurve\ - \ 1)\)\ + \
1]; \n\t\tmorepoints[ifun_]\ := \ \n\t\tAppend[
Prepend[\ \ Table[
N[ifun[t[i]]], \ {i, \ 2, \ ncurve\ - 1}], \ \n\t\t\t\t\tN[
ifun[1]]], N[ifun[npoints]]\ ]; \n\ \ \ \ \ \ Transpose[\
Map[morepoints, \ inter]\ ]\n\t\t]\), "\n",
\(\(todata[fun_, \ nx_]\ := \
Table[N[fun[\((i - 1)\)/\((nx - 1)\)]], \ {i, \ 1, \
nx}];\)\), "\n",
\(\(todata[fun_, \ nx_, \ ny_] := \ \n\t\t\ Table[
fun[\((i - 1)\)/\((nx - 1)\)\ , \((j - 1)\)/\((ny - 1)\)], \ {i,
nx}, \ {j, \ ny}];\)\), "\n",
\(\(colourdata\ = \ x : \ {_List\ .. };\)\), "\n",
\(\(todata[v_, \ nx_, \ ny_] :=
makecolourtable[v, \ nx, \ ny] /;
MatchQ[v, \ colourdata];\)\), "\n",
\(\(makecolourtable[v_, \ nx_, \ ny_] :=
Which[Length[v] == ny,
Table[v\[LeftDoubleBracket]j\[RightDoubleBracket], \ {i,
nx}, \ {j, \ ny}], \n\t\tLength[v] == nx &&
Length[First[v]] == ny, \ v, Length[v] == nx,
Table[v\[LeftDoubleBracket]i\[RightDoubleBracket], \ {i,
nx}, \ {j, \ ny}]\ ];\)\)}], "Input",
CellLabel->"In[127]:=",
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\tn1\[LeftDoubleBracket]1\
\[RightDoubleBracket]\ = \
Module[{v2\ = \
N[\ n1\[LeftDoubleBracket]1\[RightDoubleBracket] . \
n1\[LeftDoubleBracket]1\[RightDoubleBracket]]}, \
If[v2\ != \ 0,
normalize[\
n1\[LeftDoubleBracket]1\[RightDoubleBracket]], \n\t\t\
normalize[Cross[tangent\[LeftDoubleBracket]1\[RightDoubleBracket], \
weirdvector]]]\ ]\ ; \ \n\t\tDo[\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\tvw\ = \
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[135]:=",
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\tx\[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"}], "\n",
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[136]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Algorithms for getting normals and constructing lattice", \
"Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
\(\(mostperpaxis[v_] := \
Module[{axisnumber}, \[IndentingNewLine]axisnumber = \(Ordering[
Abs[v],
1]\)\[LeftDoubleBracket]1\[RightDoubleBracket]; \ \
\[IndentingNewLine]Switch[axisnumber, \
1, \ {1, 0,
0}, \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 2, \ {0, 1,
0}, \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 3, \ {0, 0,
1}]];\)\), "\[IndentingNewLine]",
\(\(standardframe[
tangent_] := \[IndentingNewLine]Module[{mynormals = {}, \
mybinormals = {}, newbinormal}, \
newbinormal\ = \
mostperpaxis[
tangent\[LeftDoubleBracket]1\[RightDoubleBracket]]; \
\[IndentingNewLine]Do[
newnormal\ = \
Cross[newbinormal, \
tangent\[LeftDoubleBracket]i\[RightDoubleBracket]] //
normalize; \[IndentingNewLine]newbinormal\ = \
Cross[tangent\[LeftDoubleBracket]i\[RightDoubleBracket], \
newnormal]; \[IndentingNewLine]AppendTo[mynormals, \
newnormal];
AppendTo[mybinormals, \ newbinormal], \ {i, 1, \
Length[tangent]}]; \[IndentingNewLine]{mynormals, \
mybinormals} // Transpose\[IndentingNewLine]];\)\)}], "Input",
CellLabel->"In[138]:=",
InitializationCell->True],
Cell["\<\
The standard algorithm shoots from one end to the other; if the curve is \
closed and there is a rotational transform then mynormal and mybinormal will \
not line up at the join.\
\>", "Text",
InitializationCell->True,
FontFamily->"Courier"],
Cell["\<\
closedtubetolerance = 0.01;
closedcurve[c_] := Module[{typicaldistance, endgap},
typicaldistance = Norm[c[[3]] - c[[2]]];
endgap = Norm[Last[c] - First[c]]; endgap/typicaldistance <
closedtubetolerance];
anglejump[frame_, naround_] := Module[{ang, maxang = Pi/naround},
ang = Mod[ArcCos[First[frame][[1]] . Last[frame][[1]]], 2*maxang];
If[ang > maxang, ang = ang - 2*maxang]; ang];
addtwist[twist_, nalong_, frame_] := Module[{deltatwist},
deltatwist = twist/(nalong - 1); Table[rotate[frame[[i]],
deltatwist*(i - 1)], {i, 1, nalong}]]; \
\>", "Input",
CellLabel->"In[333]:=",
InitializationCell->True],
Cell[BoxData[
RowBox[{
RowBox[{
RowBox[{\(getnormals[curve_, \ algo_]\), " ", ":=", " ",
RowBox[{"Module", "[",
RowBox[{\({\ ncurve\ = \ Length[curve], \ tangent, \ normal, \
binormal, \ i, frame}\), ",", "\n", "\t ",
RowBox[{\(tangent\ \ \ = \ Map[normalize, \ deriv[curve]]\),
";", "\[IndentingNewLine]", " ",
RowBox[{"Switch", "[",
RowBox[{
"algo", ",", "\n", "\t", \(x : {_, _, _}\), ",",
" ", \(normal\ \ \ \ \ = \
Map[normalize, \ \ Map[Cross[#, algo] &, \
tangent]]; \n\t\t\t\ \ \ \ \ \ \ \ \ \ \ \ binormal\
\ = MapThread[Cross, \ {tangent, \
normal}]; \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ frame = \
Transpose[{normal, \ binormal}]\), ",", " ", "\n",
" ", "xytube", ",",
" ", \(normal\ = \
Table[{0.6, \ 0.8, 0}, \ {i, \
ncurve}]; \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ binormal\ = \
Table[{0.8, \ \(-0.6\), \ 0}, \ {i, \
ncurve}]\ ; \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ frame =
Transpose[{normal, \ binormal}]\), ",", "\n", "\t",
"frenettube", ",",
" ", \(normal\ \ \ \ \ = \
normalvector[
tangent]; \n\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ \ \ binormal\ = MapThread[
Cross, \ {tangent, \
normal}]; \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ frame =
Transpose[{normal, \ binormal}]\), ",",
"\[IndentingNewLine]",
StyleBox[\( (*\ default\ or\ standardtube\ *) \),
FontColor->RGBColor[1, 0, 0]], "_", ",",
" ", \(frame = standardframe[tangent]\)}], "\n", "\t\t",
"]"}], ";", " ", "frame"}]}], "\n", "\t", "]"}]}], ";"}],
"\t"}]], "Input",
CellLabel->"In[38]:=",
InitializationCell->True],
Cell[BoxData[
RowBox[{"\t",
RowBox[{
RowBox[{\(getlattice[curve_, \ shapefun_, \ naround_, \ nalong_, \
twist_, \ algo_, \ alignedtube_]\), ":=", " ",
RowBox[{"Module", "[",
RowBox[{\({twistcorrection, costable, sintable, frame, frame1, 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[{\(frame1\ = \ getnormals[curve, \ algo]\), ";",
" ", \(frame = frame1\), ";", "\n",
StyleBox[\( (*\ Add\ extra\ twist\ *) \),
FontColor->RGBColor[1, 0, 0]],
StyleBox["\[IndentingNewLine]",
FontColor->RGBColor[1, 0, 0]],
" ", \(rotationaltransform\ = \
If[alignedtube\ && \ closedcurve[curve],
anglejump[frame1, \ naround], \ 0]\), ";",
"\[IndentingNewLine]", \(twistcorrection\ = \
2\ Pi\ twist\ - \ rotationaltransform\), ";",
"\[IndentingNewLine]", \(If[twistcorrection\ != \ 0, \
frame\ = \ addtwist[twistcorrection, nalong, \ frame1]]\),
";", "\n",
StyleBox[\( (*\
Table\ look\ up\ speeds\ things\ \(up!\)\ *) \),
FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]",
" \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]} . \
frame\[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\tTable[\
radiustable\[LeftDoubleBracket]j,
i\[RightDoubleBracket] {costable\
\[LeftDoubleBracket]j\[RightDoubleBracket], \
sintable\[LeftDoubleBracket]j\
\[RightDoubleBracket]} . \
frame\[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]\),
";", \(AppendTo[lattice, \
lattice\[LeftDoubleBracket]1\[RightDoubleBracket]]\), ";",
"\n", " ", "lattice"}]}], " ", "\n", "\t\t", "]"}]}],
";"}]}]], "Input",
CellLabel->"In[347]:=",
InitializationCell->True]
}, Open ]],
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_, \ twist_, \ algo_, \ alignedtube_]\), " ", ":=", " ",
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, \
twist, \ algo, \ alignedtube]\), ";", "\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[140]:=",
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[{
RowBox[{
RowBox[{
RowBox[{\(colorpolygondata[directivetable_, \ lattice_, \ j_,
i_]\), ":=",
StyleBox[" ",
FontColor->RGBColor[1, 0, 0]],
"\n", \(FlattenAt[{\
resolvecolors[
directivetable\[LeftDoubleBracket]j,
i\[RightDoubleBracket]],
polygondata[lattice, \ j, i]}, \ 1]\)}], ";"}], "\n",
"\n", \(getcolortube[curve_, \ directive_, \ shapefun_, \
naround_, \ range_, \ twist_, \ 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, \
twist, \ algo, alignedtube]\), ";", " ", "\n",
"\t\t\t", \(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[141]:=",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell["User functions: tube, quicktube, checkedcurve", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(\(\ \)\(standardtube = 0; frenettube\ = \ 1; \ xytube\ = \ 2;\ \n
\(Options[tube] = {nalongtube \[Rule] 40, naroundtube \[Rule] 12,
tuberange \[Rule] All, twistnumber \[Rule] 0,
alignedtube\ \[Rule] \ True,
tubealgorithm\ -> \ standardtube};\)\n
\(tubedefaults\ = \ Options[tube];\)\n\n
\(checkedcurve[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\(twistnumber\ \ /. {opts}\) /.
Options[tube], \n\ \ \ \ \ \ \ \ \ \(tubealgorithm\ /. {opts}\) /.
Options[tube], \ \(alignedtube\ /. {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\(twistnumber\ \ \ /. {opts}\) /.
Options[tube], \n\ \ \ \ \ \ \ \ \ \(tubealgorithm\ /. {opts}\) /.
Options[tube]\n\ \ \ \ \ ];\)\n\n
\(tube[curve_, \ directive_, \ 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\(twistnumber\ \ \ /. {opts}\) /.
Options[tube], \n\ \ \ \ \ \ \ \ \ \(tubealgorithm\ /. \
{opts}\) /. Options[tube]\n\ \ \ \ \ ] /;
MatchQ[directive, \ colourdata];\)\n\n
\ \(quicktube[curve_] :=
Show[tube[curve, Eggshell, \ 1], \
Boxed -> \ False];\)\)\)\)], "Input",
CellLabel->"In[142]:=",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell["PovRay data functions", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
\(\(circnext[i_, \ n_] := \
If[i \[Equal] \ n, \ 2, \ i + 1];\)\), "\[IndentingNewLine]",
\(\(circbefore[i_, \ n_] := \
If[i \[Equal] \ 1, \ n - 1, \ i - 1];\)\), "\[IndentingNewLine]",
\(\(surfacenormal[lattice_, \ j_, i_, \ curveisclosed_, \ nm_, \
nax_] := \ Module[{x, \ a, b, c, d, perpvec1, perpvec2, perpvec3,
perpvec4},
x\ = \ lattice\[LeftDoubleBracket]j, i\[RightDoubleBracket]; \
a = lattice\[LeftDoubleBracket]circnext[j, nm], \
i\[RightDoubleBracket]; \[IndentingNewLine]c =
lattice\[LeftDoubleBracket]circbefore[j, \ nm], \
i\[RightDoubleBracket]; \ \[IndentingNewLine]If[
curveisclosed, \ \[IndentingNewLine]\ \ \ \ \ \ \ \ b = \
If[i \[Equal] 1, \
lattice\[LeftDoubleBracket]j, nax - 1\[RightDoubleBracket],
lattice\[LeftDoubleBracket]j,
i - 1\[RightDoubleBracket]]; \[IndentingNewLine]\ \ \ \ \ \ \
\ \ d = If[i \[Equal] \ nax, \
lattice\[LeftDoubleBracket]j, \ 2\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j, \
i + 1\[RightDoubleBracket]], \[IndentingNewLine]\ \ \ \ \ \ \
\ \ b = \ If[i \[Equal] 1, \
2 lattice\[LeftDoubleBracket]j, 1\[RightDoubleBracket] -
lattice\[LeftDoubleBracket]j, 2\[RightDoubleBracket],
lattice\[LeftDoubleBracket]j,
i - 1\[RightDoubleBracket]]; \[IndentingNewLine]\ \ \ \ \ \ \
\ \ d = If[i \[Equal] \ nax, \
2 lattice\[LeftDoubleBracket]j, \ nax\[RightDoubleBracket] -
lattice\[LeftDoubleBracket]j, \
nax - 1\[RightDoubleBracket], \
lattice\[LeftDoubleBracket]j, \
i + 1\[RightDoubleBracket]]]; \[IndentingNewLine]\
perpvec1\ = \ Cross[a - x, d - x] // normalize; \ \ perpvec2\ = \
Cross[d - x, c - x] //
normalize; \ \[IndentingNewLine]perpvec3\ = \
Cross[c - x, b - x] // normalize; \ \ perpvec4\ = \
Cross[b - x, a - x] //
normalize; \[IndentingNewLine]Chop[\((perpvec1 + perpvec2 +
perpvec3 + perpvec4)\)/4]];\)\), "\[IndentingNewLine]",
\(\(pointnormal[lattice_, \ curveisclosed_, \ naround_, \ nalong_] := \
Table[{lattice\[LeftDoubleBracket]j, \ i\[RightDoubleBracket],
surfacenormal[lattice, \ j, i, \ curveisclosed, \ naround, \
nalong]}, {j, \ 1, \ naround}, \ {i, \ 1, \
nalong}];\)\)}], "Input",
CellLabel->"In[358]:=",
InitializationCell->True],
Cell["\<\
getsmoothquads[curve_, shapefun_] := If[MatchQ[curve, curvedata],
Module[{nalong, naround, algo, lattice, isitclosed},
naround = naroundtube /. Options[tube, naroundtube];
nalong = nalongtube /. Options[tube, nalongtube];
algo = tubealgorithm /. Options[tube, tubealgorithm];
lattice = getlattice[curve, shapefun, naround, nalong,
twistnumber = 0, algo, alignedtube]; isitclosed =
closedcurve[curve]; sheaf = pointnormal[lattice, isitclosed,
naround + 1, nalong]; smoothquads =
Flatten[Table[polygondata[sheaf, j, i], {i, 1, nalong - 1},
{j, 1, naround}], 1]; Chop[smoothquads, 1/10^5]],
Message[tube::bad]];
getpovray[curve_, shapefun_] :=
Module[{nal = nalongtube /. Options[tube, nalongtube],
clen = Length[curve]}, If[clen == 0 || MatchQ[curve, curvedata],
getsmoothquads[checkedcurve[curve, nal], shapefun],
Flatten[Table[getsmoothquads[checkedcurve[curve[[i]], nal],
shapefun], {i, 1, clen}], 1]]]; \
\>", "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell["Writing routines", "Text",
InitializationCell->True],
Cell[BoxData[
\(\(\(\(pvertexnormal[t_, {v_, \ w_}] :=
Write @@ {t, \ "\<<\>", \
v\[LeftDoubleBracket]1\[RightDoubleBracket], "\<,\>",
v\[LeftDoubleBracket]2\[RightDoubleBracket], "\<,\>",
v\[LeftDoubleBracket]3\[RightDoubleBracket], "\<>,\>", \
\[IndentingNewLine]"\<<\>", \
w\[LeftDoubleBracket]1\[RightDoubleBracket], "\<,\>",
w\[LeftDoubleBracket]2\[RightDoubleBracket], "\<,\>",
w\[LeftDoubleBracket]3\[RightDoubleBracket], "\<>\>"};\)\
\[IndentingNewLine]
\(pvertexnormalcomma[t_, {v_, \ w_}] :=
Write @@ {t, \ "\<<\>", \
v\[LeftDoubleBracket]1\[RightDoubleBracket], "\<,\>",
v\[LeftDoubleBracket]2\[RightDoubleBracket], "\<,\>",
v\[LeftDoubleBracket]3\[RightDoubleBracket], "\<>,\>", \
\[IndentingNewLine]"\<<\>", \
w\[LeftDoubleBracket]1\[RightDoubleBracket], "\<,\>",
w\[LeftDoubleBracket]2\[RightDoubleBracket], "\<,\>",
w\[LeftDoubleBracket]3\[RightDoubleBracket], "\<>,\>"};\)\
\[IndentingNewLine]
\(pvtri[t_, quad_] := \
Module[{},
Write @@ {t, "\"}; \
\[IndentingNewLine]pvertexnormalcomma[t,
quad\[LeftDoubleBracket]1\[RightDoubleBracket]]; \
\[IndentingNewLine]pvertexnormalcomma[t,
quad\[LeftDoubleBracket]2\[RightDoubleBracket]];
pvertexnormal[t,
quad\[LeftDoubleBracket]3\[RightDoubleBracket]]; \
\[IndentingNewLine]Write @@ {t, "\<} smooth_triangle {\>"};
pvertexnormalcomma[t,
quad\[LeftDoubleBracket]3\[RightDoubleBracket]]; \
\[IndentingNewLine]pvertexnormalcomma[t,
quad\[LeftDoubleBracket]4\[RightDoubleBracket]];
pvertexnormal[t, quad\[LeftDoubleBracket]1\[RightDoubleBracket]];
Write[t, "\<}\>"];\[IndentingNewLine]];\)\[IndentingNewLine]
\(povraywrite[t_, \ name_, \ data_] := \
Module[{},
Write[t, "\<#declare \>"\ , \
name, \ "\< = object {mesh { \>"]; \[IndentingNewLine]Do[
pvtri[t, data\[LeftDoubleBracket]i\[RightDoubleBracket]], \ {i, \
1, Length[data]}]; \[IndentingNewLine]Write[
t, \ "\<}}\>"];\ \[IndentingNewLine]];\)\[IndentingNewLine]
\(topovray[file_, stuff_] :=
Module[{t, data, \ name}, \ \ t\ = \
OpenWrite[file, \ FormatType \[Rule] \ OutputForm, \
PageWidth \[Rule] \ 88];
If[ArrayDepth[stuff] \[Equal] 1, \
data = getpovray @@ \((Drop[stuff, \ 1])\); \
name\ = \ stuff\[LeftDoubleBracket]1\[RightDoubleBracket];
povraywrite[t, name, data], \[IndentingNewLine]Do[
data = getpovray @@ \((Drop[
stuff\[LeftDoubleBracket]i\[RightDoubleBracket], \
1])\); name\ = \
stuff\[LeftDoubleBracket]i, 1\[RightDoubleBracket];
povraywrite[t, name, data], \ {i, \
Length[stuff]}]]; \[IndentingNewLine]Close[
t]];\)\)\(\ \)\)\)], "Input",
InitializationCell->True]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell["User functions: fluxlines, fluxcurves", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(\(\(getlongcurves[tubeobject_, \ nlonglines_, \ naround_, \
nalong_] := \n
Module[{polylist, \ toomanylines, \ lastpoints, \ mostpoints, \ i, \
j}, \ polylist\ = \(tubeobject\ // First\) //
Last; \n\t\t\t\t\t\t\ toomanylines\ = \
polylist /. \
Polygon[{a_, \ b_, \ c_, \ d_}]\ \ -> \
a; \n\t\tlastpoints\ = \
Table[polylist\[LeftDoubleBracket]\((\
nalong - 2)\)\ naround\ + \
1\ + \ \ j\ naround/\
nlonglines\[RightDoubleBracket] /. \
Polygon[{a_, \ b_, \ c_, \ d_}]\ \ -> \ d, {j, \
0, \ \ nlonglines - 1}]; \n\t\tmostpoints\ = \
Table[toomanylines\[LeftDoubleBracket]\((i\ \ naround +
1)\)\ + \
j\ naround/\ nlonglines\[RightDoubleBracket], \ {i, 0, \
nalong - 2}, {j, \
0, \ \ nlonglines - 1}]; \n\t\t\t\t\t\t\t\t\t\tTranspose[
Append[mostpoints, \ lastpoints]]\n\t];\)\n
\(fluxcurves[curve_, \ radius_, \ nlonglines_] := \
Module[{newtube, \ naround, nalong}, \n\t\t\t\tnaround\ =
naroundtube /. Options[tube, \ naroundtube]\ ;
nalong\ =
nalongtube /. \
Options[tube, \ nalongtube]; \ \n\t\t\t\ naround\ = \
Ceiling[naround/nlonglines]\ nlonglines; \n\t\tnewtube =
tube[curve, \ White, \ radius, \ naroundtube\ -> naround, \
nalongtube -> nalong]; \ \n\t\t\t\t\t\t\t\ getlongcurves[
newtube, \ \ \ nlonglines, \ naround, \
nalong]\ \ ];\)\)\(\t\t\t\)\)\)], "Input",
CellLabel->"In[150]:=",
InitializationCell->True],
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\tFlatten[\
Table[toomanylines\[LeftDoubleBracket]\((i\ \ naround +
1)\)\ + \
j\ naround/\ nlonglines\[RightDoubleBracket], \ {i, 0, \
nalong - 2}, {j, \ 0, \ \ nlonglines - 1}],
1]\n\t];\)\n\), "\n",
\(\(getshortlines[tubeobject_, \ nshortlines_, \ \ naround_, \
nalong_] := \n\t
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, b}]; \n\t\t\t\t\t\t\t\t\t\tFlatten[\
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, \ naround, nalong}, \n\t\t\t\tnaround\ =
naroundtube /. Options[tube, \ naroundtube]\ ;
nalong\ =
nalongtube /. \
Options[tube, \ nalongtube]; \ \n\t\t\t\ naround\ = \
Ceiling[naround/nlonglines]\ nlonglines; \n\t\t\tnalong\ = \
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[152]:=",
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\thwidth\ = \
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\ttop\ = \ {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\tside1\ \ = \ {b, c, \
bot[c], \ bot[b]}; \ \tside2\ \ = \ {g, a, \ bot[a], \
bot[g]}; \n\t\twing1\ \ = \ {d, e, \ bot[e], \
bot[d]}; \ \twing2\ \ = \ {e, f, \ bot[f], \
bot[e]}; \ \n\t\tback1\ \ = \ {d, c, \ bot[c], \
bot[d]}; \ \tback2\ \ = \ {g, f, \ bot[f], \
bot[g]}; \n\t\t\ polly\ = \ {\ top, \ arrowtop, \ bottom, \
arrowbottom, \ end, \ side1, \ side2, \ wing1, \ wing2, \
back1, \ back2}; \n\t\tMap[Polygon, polly]];\)\(\n\)
\(\t\t\)\)\)], "Input",
CellLabel->"In[157]:=",
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[158]:=",
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\ta\ = \ fun[t]; \ \n\t\tb\ = \
fun[Mod[t + eps, \ 1]]; \n\t\tlen\ = \
Sqrt[\((b - a)\) . \((b - a)\)]; \n\t\tqp\ = \ \((b - a)\)/
len; \n\t\twoof\ = \
Options[Graphics3D, \ ViewPoint]; \n\t\tview\ = \
ViewPoint\ /. \ woof; \n\t\tnorm\ = \
normalize[view]; \n\t\tnorm\ =
Cross[qp, \ Cross[norm, \ qp]]; \n\t\tbinorm\ = \
Cross[norm, \
qp]; \t\ \ \ off\ = \((radius\ + \
0.1\ len)\)*\ \(rotate[{norm, \ binorm}, \
theta]\)\[LeftDoubleBracket]1\[RightDoubleBracket]; \n\t\t\
ppp\ = \ a\ + \ off; \n\t\tqqq\ = \ b\ + \ off; \n\t\tshowarrow[ppp, qqq,
off, \ \(arrowcolor\ /. {opts}\) /.
Options[sidearrow], \ \n\t\t\(arrowthickness\ \ \ \ /. \
{opts}\) /. Options[sidearrow]]];\)\)}], "Input",
CellLabel->"In[161]:=",
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\tnz =
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\tleft = \
box\[LeftDoubleBracket]1, 1\[RightDoubleBracket] - margin; \
right = box\[LeftDoubleBracket]2, 1\[RightDoubleBracket] +
margin; \
bot = box\[LeftDoubleBracket]1, 3\[RightDoubleBracket];
tresswidth = right; \n\t\tfront = \
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[163]:=",
InitializationCell->True],
Cell[BoxData[
\(\(braidtubes[braid_, \ colors_, \ radius_, \ braidrange_] :=
Table[\n\t\ttube[
braid\[LeftDoubleBracket]i\[RightDoubleBracket], \ {EdgeForm[], \
colors\[LeftDoubleBracket]Mod[i - 1, \ \ Length[colors]] +
1\[RightDoubleBracket]}, radius, \
tuberange\ -> \ braidrange]\ , \n\t\t\ \ \ {i, \ 1, \
Length[braid]}];\)\)], "Input",
CellLabel->"In[165]:=",
InitializationCell->True],
Cell[BoxData[
\(\(nicecolors = {RGBColor[1, \ 0, \ 0], RGBColor[0, 1, \ 1],
RGBColor[1, \ 1, \ 0],
RGBColor[0, 1, \ 0], \n\t\tRGBColor[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[166]:=",
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\tbox =
boundingbox[braidlist]; \
tresswidth\ = \
box\ \[LeftDoubleBracket]2, 1\[RightDoubleBracket]\ - \
box\ \[LeftDoubleBracket]1,
1\[RightDoubleBracket]; \n\t\tbraidrange[vec_]\ := \
If[vec\[LeftDoubleBracket]3\[RightDoubleBracket] >= \
box\ \[LeftDoubleBracket]1, 3\[RightDoubleBracket]\ && \
vec\[LeftDoubleBracket]3\[RightDoubleBracket] <= \
box\ \[LeftDoubleBracket]2, 3\[RightDoubleBracket], \
1, \ \(-1\)]; \n\t\tgraphicslist = \
Flatten[{pedestal[box, \ thick, \ margin],
braidtubes[braidlist, colors, \ radius, \
braidrange]}]; \n\t\tGraphics3D[
Table[graphicslist\[LeftDoubleBracket]i,
1\[RightDoubleBracket], \ {i, \ 1, \
Length[graphicslist]}], \
PlotRange -> All\ ]\n\t];\)\)}], "Input",
CellLabel->"In[167]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["extras: intrinsics, plait", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
\(\(pointmap[curvepoint_, \ normalspoint_, \ axispoint_] := \
axispoint\ + \
curvepoint\[LeftDoubleBracket]1\[RightDoubleBracket]\ *\
normalspoint\[LeftDoubleBracket]1\[RightDoubleBracket]\ + \
curvepoint\[LeftDoubleBracket]2\[RightDoubleBracket]\ *\
normalspoint\[LeftDoubleBracket]2\[RightDoubleBracket];\)\), "\n\
",
\(\(curvemap[curve_, \ normals_, \ axis_] := \
MapThread[pointmap, \ {curve, \ normals, \ axis}];\)\)}], "Input",
CellLabel->"In[169]:=",
InitializationCell->True],
Cell[BoxData[
\(\(plaitlist[curvelist_, axis_, \ \ opts___]\ :=
Module[{braidlist, axiscurve, \ np, \ algo,
i}, \ \n\t\talgo\ = \ \ \(tubealgorithm\ /. {opts}\) /.
Options[tube]; \n\t\tnp\ = \ \(nalongtube /. {opts}\) /.
Options[tube]; \n\t
braidlist = \t
Map[checkedcurve[#, np] &, \ curvelist]; \n\t\taxiscurve\ = \
checkedcurve[axis, \ np];
bothnormals\ = \ getnormals[axiscurve, \ algo]; \n\t
Table[curvemap[
braidlist\[LeftDoubleBracket]i\[RightDoubleBracket], \
bothnormals, \ axiscurve], \ {i, \
Length[braidlist]}]];\)\)], "Input",
CellLabel->"In[171]:=",
InitializationCell->True],
Cell[BoxData[{
\(\(vectormod[v_]\ \ := \ N[Sqrt[v . v]];\)\), "\n",
\(\(intrinsics[curve_, \ opts___] :=
Module[{c, \ tang, \ tangent, \ normal, \ binormal, \ np, \ dnds, \
dtds, \ curvature, \ torsion, \ zforce},
np\ = \ \(nalongtube /. {opts}\) /.
Options[tube]; \n\t\t\ \ c\ = \ checkedcurve[curve, \ np]; \n
tang\ = \ deriv[c]; \ dtds\ = \ Map[vectormod, tang]; \
tangent\ \ \ \ \ = \ Map[normalize, \ tang]; \n
normal\ = \
Chop[deriv[tangent]/
dtds]; \ \n\t\t\ \ \ \ zforce\ \ \ \ \ \ \ \ \ = \ \
\(Transpose[
normal]\)\[LeftDoubleBracket]3\[RightDoubleBracket]; \n\t\t\ \
\ \ \ curvature\ = \ Map[vectormod, \ normal]; \n
normal\ = \ Map[normalize, \ normal]; \n
binormal\ = MapThread[Cross, \ {tangent, \ normal}]; \n
dnds\ = \ deriv[normal]/dtds; \n
torsion\ = \ \tMapThread[
Dot, \ {dnds, \ binormal}]; \n\t\t{curvature, \
torsion, \ \ zforce}\n\t];\)\)}], "Input",
CellLabel->"In[172]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[" Extras: gltress, slidebraid, satellites", "Subsubsection",
InitializationCell->True],
Cell[CellGroupData[{
Cell["User functions: satellites", "Text",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
\(\(getlongcurves[tubeobject_, \ nlonglines_, \ naroundx_, \
nalongxx_] := \n
Module[{polylist, \ toomanylines, \ segments, \ i, \ j}, \
polylist\ = \(tubeobject\ // First\) //
Last; \n\t\t\t\t\t\t\ toomanylines\ = \
polylist /. \
Polygon[{a_, \ b_, \ c_, \ d_}]\ \ -> \ {a,
d}; \n\t\t\t\t\t\t\t\t\tsegments\ = \
Table[toomanylines\[LeftDoubleBracket]\((i\ \ naroundx +
1)\)\ + \
j\ naroundx/\
nlonglines\[RightDoubleBracket], \ \n\t\t\t\t\t{j, \
0, \ \ nlonglines - 1}, {i, 0, \
nalongxx -
2}]; \t\ \n\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \t\ Table[\
Append[Table[
segments\[LeftDoubleBracket]j, i,
1\[RightDoubleBracket], \ \ {i, \ nalongxx - 1}],
segments\[LeftDoubleBracket]j, \ nalongxx - 1, \
2\[RightDoubleBracket]], {j, \
nlonglines}]\ \n\t];\)\n\), "\n",
\(\(satellites[curve_, \ radius_, \ nlonglines_, \ nshortlines_] :=
Module[{newtube, \ lines, naround, nalong}, \n\t\t\t\tnaround\ =
naroundtube /. Options[tube, \ naroundtube]\ ;
nalong\ =
nalongtube /. \
Options[tube, \ nalongtube]; \ \n\t\t\t\ naround\ = \
Ceiling[naround/nlonglines]\ nlonglines; \n\t\t\tnalong\ = \
1 + Ceiling[\((nalong - 1)\)/
nshortlines]\ nshortlines; \n\t\tnewtube =
tube[curve, \ White, \ radius, \ naroundtube\ -> naround, \
nalongtube -> nalong]; \n\t\tgetlongcurves[
newtube, \ \ \ nlonglines, \ naround, \
nalong]\ ];\)\t\t\), "\n",
\(\(satellites[curve_, \ radius_, \ nlonglines_] := \
satellites[curve, \ radius, \ nlonglines,
nalongtube /. \ Options[tube, \ nalongtube]];\)\t\)}], "Input",
CellLabel->"In[174]:=",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell["User functions: gltress, slidebraid", "Text",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[{
\(\(nudge = 1.1;\)\), "\n",
\(\(glpedestal[box_, \ \ thick_, \
margin_] := \ \ Module[{left, \ right, \ front, \ back, \ bot, \
top}, \ \n\t\t\tleft = \
box\[LeftDoubleBracket]1, 1\[RightDoubleBracket] - margin; \
right = box\[LeftDoubleBracket]2, 1\[RightDoubleBracket] +
margin; \
bot = box\[LeftDoubleBracket]1, 3\[RightDoubleBracket];
tresswidth = right; \n\t\tfront = \
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\ - nudge\ thick}, \ {right, \
back, \ bot + \((1 - nudge)\)\ thick}]],
Graphics3D[
Cuboid[{left, \ front,
top\ - \((1 - nudge)\)\ thick}, \ {right, \ back,
top + nudge\ thick}]]}];\)\)}], "Input",
CellLabel->"In[177]:=",
InitializationCell->True],
Cell[BoxData[
\(\(gltress[curvelist_, radius_, \ plinth_, \ opts___]\ :=
Module[{colors, braidlist, ped, \ box,
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\ = \
plinth; \[IndentingNewLine]\ \ \ ped\ = \
ped\ *\ If[NumberQ[radius], \ radius, \
radius[0, 0]]; \n\t\tmargin\ = \
ped\[LeftDoubleBracket]1\[RightDoubleBracket]\ ; \n\t\tthick\ \ \ \
\ \ = \ ped\[LeftDoubleBracket]2\[RightDoubleBracket]\ ; \[IndentingNewLine]\
\tbox = boundingbox[braidlist]; \
tresswidth\ = \
box\ \[LeftDoubleBracket]2, 1\[RightDoubleBracket]\ - \
box\ \[LeftDoubleBracket]1,
1\[RightDoubleBracket]; \n\t\tgraphicslist =
Flatten[{glpedestal[box, \ thick, \ margin],
braidtubes[braidlist, colors, \ radius, \
All]}]; \n\t\tGraphics3D[
Table[graphicslist\[LeftDoubleBracket]i,
1\[RightDoubleBracket], \ {i, \ 1, \
Length[graphicslist]}], \
PlotRange -> All\ ]\n\t];\)\)], "Input",
CellLabel->"In[179]:=",
InitializationCell->True],
Cell[BoxData[{
\(\(slidecurve[curve_, \ a_]\ := \
Map[#\ + \ a &, \ curve];\)\), "\n",
\(\(slidebraid[braid_, \ translate_]\ := \
Map[slidecurve[#, \ {translate, 0, 0}] &, \ braid];\)\)}], "Input",
CellLabel->"In[180]:=",
InitializationCell->True]
}, Open ]]
}, Closed]]
}, Open ]],
Cell[BoxData[
\(End[\ ]; \ EndPackage[\ ]; \ On[General::spell1]\)], "Input",
CellLabel->"In[182]:=",
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[183]:=",
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[184]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["artin", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(artin::usage\ = \ \*"\"\\"";\)\)], "Input",
CellLabel->"In[185]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["scaledbraid", "Subsubsection",
InitializationCell->True,
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[186]:=",
InitializationCell->True]
}, Open ]],
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[187]:=",
InitializationCell->True,
FontFamily->"Courier"]
}, Closed]],
Cell[CellGroupData[{
Cell["torusknot", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(torusknot::usage\ = \ \n\ "\";\)\)], "Input",
CellLabel->"In[189]:=",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["Code", "Section",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(\(Begin["\<`Private`\>"];\)\)], "Input",
CellLabel->"In[190]:=",
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\tu\ = \ {x2 - x1, \ y2 - y1, \
0}; \n\t\tdistance\ = \ Sqrt[u . u]; \n\t\tuhat\ = \
u/distance; \n\t\tmidpoint\ = \ \(({x1, \ y1, \ 0}\ + \ {x2, \
y2, \ 0})\)/2; \n\t\tmu\ = \ Pi\ \((t - 1/2)\); \n\t\tN[
midpoint\ + \
distance\ \((Sin[mu]\ uhat\ + \ Cos[mu]\ {0, 0, 1})\)/
2]\n];\)\)], "Input",
CellLabel->"In[191]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["artin", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell[BoxData[
\(Clear[artin]\)], "Input",
CellLabel->"In[192]:=",
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\tDo[{\n\t\tsig\ =
Abs[braidword\[LeftDoubleBracket]iz\[RightDoubleBracket]],
mu\ = \
Sign[braidword\[LeftDoubleBracket]
iz\[RightDoubleBracket]], \n\t\t\t\t\tIf[
0 < sig <
nstrings, {\n\t\t\t\t\th = \ \((iz - 0.5)\) deltaz, \
braid = \
braidappend[
braid, \ \n\t\t\t\t\t\tsimplebraid[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\tIf[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[193]:=",
InitializationCell->True],
Cell[BoxData[{
\(\(flip[perm_, \ s_]\ :=
If[0 < s <
Length[perm], \ \ Module[{new, \ leftstring, \
rightstring}, \ \n\t\t\tleftstring\ \ = \(Position[perm, \
s]\)\[LeftDoubleBracket]1,
1\[RightDoubleBracket]; \n\t\t\trightstring = \(Position[
perm, \ s + 1]\)\[LeftDoubleBracket]1,
1\[RightDoubleBracket]; \n\t\t\tnew\ = \
ReplacePart[perm, \ s + 1, \ leftstring]; \n\t\t\tReplacePart[
new, \ s, \ rightstring]]\n\t];\)\ \), "\n",
\(\(braidcat[botbraid_, \ topbraid_]\ := \
MapThread[Join, \ {botbraid, \ topbraid}];\)\), "\n",
\(\(braidappend[braid_, \ points_]\ := \
MapThread[Append, \ {braid, \ points}];\)\)}], "Input",
CellLabel->"In[195]:=",
InitializationCell->True],
Cell[BoxData[
\(\(\(simplebraid[nstrings_, perm_, \ s_, \ mu_, h_] :=
If[0 < s <
Length[perm], \ \ Module[{nextlevel, \ leftstring, \
rightstring, \
j}, \ \n\t\t\tleftstring\ \ = \(Position[perm, \
s]\)\[LeftDoubleBracket]1,
1\[RightDoubleBracket]; \n\t\t\trightstring = \(Position[
perm, \ s + 1]\)\[LeftDoubleBracket]1,
1\[RightDoubleBracket]; \n\t\tnextlevel\ \ \ \ \ = \
Table[{perm\[LeftDoubleBracket]j\[RightDoubleBracket], 0,
h}, \ {j, nstrings}]; \n\t\tnextlevel\ \ \ \ \ = \
ReplacePart[nextlevel, {s + 0.5, \ \(-0.5\) mu, \ h}\ ,
leftstring]; \ \t\n\t\tReplacePart[
nextlevel, \ {s + 0.5, \ \ 0.5 mu, \ h}, rightstring]\ ],
Null\n\t\t];\)\(\n\)
\(\t\t\)\)\)], "Input",
CellLabel->"In[198]:=",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["scaledbraid", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell["\<\
scaledbraid[braid_, xyscale_, n_] := Module[{ncurves = Length[braid], \
tempbraid, jcurve, ipoint}, tempbraid = Map[checkedcurve[#, n]&, braid];
Table[{xyscale tempbraid\[LeftDoubleBracket]jcurve, ipoint, 1\
\[RightDoubleBracket],
xyscale tempbraid\[LeftDoubleBracket]jcurve, ipoint, 2\
\[RightDoubleBracket], ipoint-1},
\t\t\t{jcurve, ncurves}, {ipoint,n}]];\t\
\>", "Input",
CellLabel->"In[199]:=",
InitializationCell->True,
FontFamily->"Courier"]
}, Open ]],
Cell[CellGroupData[{
Cell["readcurves, writecurves", "Subsubsection",
InitializationCell->True,
FontFamily->"Courier"],
Cell["\<\
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}] ];
readcurves[file_] := Module[{ncurves, nz, data, i}, data = ReadList[file, \
Number, RecordLists -> True];
\t\tncurves = data\[LeftDoubleBracket]1, 1\[RightDoubleBracket];
\t\tnz = data\[LeftDoubleBracket]1, 2\[RightDoubleBracket];
\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}] ];
writecurves[file_,curves_]:= Module[{t, ncurves=Length[curves],
nz = Length[ curves\[LeftDoubleBracket]1\[RightDoubleBracket]]-1, icurve, \
ipoint}, t = OpenWrite[file, FormatType -> OutputForm];
\t\tWrite[t, ncurves,\" \", nz];
Do[Do[Write[t,curves\[LeftDoubleBracket]icurve, ipoint, \
1\[RightDoubleBracket],\" \",
curves\[LeftDoubleBracket]icurve, ipoint, 2\[RightDoubleBracket],\" \",
curves\[LeftDoubleBracket]icurve, ipoint, 3\[RightDoubleBracket]], {ipoint, \
1, nz+1}], {icurve,ncurves}];
Close[t];
];\
\>", "Input",
CellLabel->"In[200]:=",
InitializationCell->True,
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\tcirc\ = \
majorradius\ {Cos[ax], \ Sin[ax], \ 0}; \n\t\t\toffset\ = \
minorradius \(({Cos[ax] Cos[az],
Sin[ax] Cos[az], \ \(-Sin[az]\)})\); \ \n\t\tcirc\ + \
offset];\)\)], "Input",
CellLabel->"In[203]:=",
InitializationCell->True]
}, Closed]]
}, Open ]],
Cell[BoxData[
\(End[\ ]; \ EndPackage[\ ]; \ On[General::spell1];\)], "Input",
CellLabel->"In[204]:=",
InitializationCell->True]
}, Open ]]
},
FrontEndVersion->"5.0 for Microsoft Windows",
ScreenRectangle->{{0, 1400}, {0, 928}},
AutoGeneratedPackage->Automatic,
WindowToolbars->"EditBar",
CellGrouping->Manual,
WindowSize->{1390, 883},
WindowMargins->{{Automatic, -11}, {Automatic, -62}},
Magnification->1.5,
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[1776, 53, 281, 10, 159, "Section",
InitializationCell->True],
Cell[2060, 65, 333, 6, 94, "Input",
InitializationCell->True],
Cell[2396, 73, 175, 4, 42, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[2596, 81, 86, 2, 126, "Section",
InitializationCell->True],
Cell[CellGroupData[{
Cell[2707, 87, 128, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[2838, 91, 1181, 22, 344, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[4056, 118, 108, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[4167, 122, 3064, 42, 1056, "Input",
InitializationCell->True],
Cell[7234, 166, 717, 16, 315, "Input",
InitializationCell->True],
Cell[7954, 184, 538, 9, 146, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[8529, 198, 84, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[8616, 202, 265, 5, 94, "Input",
InitializationCell->True],
Cell[8884, 209, 342, 6, 120, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[9263, 220, 99, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[9365, 224, 680, 13, 224, "Input",
InitializationCell->True],
Cell[10048, 239, 222, 4, 68, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[10307, 248, 94, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[10404, 252, 1183, 25, 387, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[11624, 282, 83, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[11710, 286, 1003, 20, 342, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[12750, 311, 107, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[12860, 315, 437, 7, 85, "Input",
InitializationCell->True],
Cell[13300, 324, 438, 8, 85, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[13775, 337, 92, 1, 38, "Subsubsection",
InitializationCell->True],
Cell[13870, 340, 603, 12, 207, "Input",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[14522, 358, 76, 2, 69, "Section",
InitializationCell->True],
Cell[14601, 362, 114, 3, 42, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[14740, 369, 104, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[14847, 373, 163, 4, 42, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[15047, 382, 132, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[15182, 386, 1941, 37, 510, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[17160, 428, 97, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[17260, 432, 3663, 66, 484, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[20960, 503, 158, 4, 38, "Subsubsection",
InitializationCell->True],
Cell[21121, 509, 2793, 59, 430, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[23951, 573, 135, 3, 38, "Subsubsection",
InitializationCell->True],
Cell[24089, 578, 1505, 30, 328, "Input",
InitializationCell->True],
Cell[25597, 610, 255, 6, 56, "Text",
InitializationCell->True],
Cell[25855, 618, 662, 14, 315, "Input",
InitializationCell->True],
Cell[26520, 634, 2439, 46, 406, "Input",
InitializationCell->True],
Cell[28962, 682, 3917, 78, 614, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[32916, 765, 117, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[33036, 769, 3172, 58, 614, "Input",
InitializationCell->True],
Cell[36211, 829, 98, 1, 34, "Text"],
Cell[36312, 832, 5347, 129, 458, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[41696, 966, 123, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[41822, 970, 2449, 42, 900, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[44308, 1017, 99, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[44410, 1021, 2710, 46, 432, "Input",
InitializationCell->True],
Cell[47123, 1069, 1071, 20, 504, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[48219, 1093, 60, 1, 34, "Text",
InitializationCell->True],
Cell[48282, 1096, 3123, 59, 484, "Input",
InitializationCell->True]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell[51454, 1161, 115, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[51572, 1165, 1801, 33, 432, "Input",
InitializationCell->True],
Cell[53376, 1200, 3032, 56, 874, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[56445, 1261, 100, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[56548, 1265, 2020, 33, 538, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[58605, 1303, 110, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[58718, 1307, 623, 13, 150, "Input",
InitializationCell->True],
Cell[59344, 1322, 1233, 22, 344, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[60614, 1349, 99, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[60716, 1353, 1582, 31, 276, "Input",
InitializationCell->True],
Cell[62301, 1386, 480, 9, 94, "Input",
InitializationCell->True],
Cell[62784, 1397, 470, 9, 94, "Input",
InitializationCell->True],
Cell[63257, 1408, 1961, 35, 406, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[65255, 1448, 103, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[65361, 1452, 579, 11, 63, "Input",
InitializationCell->True],
Cell[65943, 1465, 755, 15, 150, "Input",
InitializationCell->True],
Cell[66701, 1482, 1141, 22, 322, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[67879, 1509, 93, 1, 38, "Subsubsection",
InitializationCell->True],
Cell[CellGroupData[{
Cell[67997, 1514, 95, 2, 34, "Text",
InitializationCell->True],
Cell[68095, 1518, 2078, 39, 484, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[70210, 1562, 104, 2, 34, "Text",
InitializationCell->True],
Cell[70317, 1566, 1142, 22, 172, "Input",
InitializationCell->True],
Cell[71462, 1590, 1523, 28, 328, "Input",
InitializationCell->True],
Cell[72988, 1620, 281, 6, 68, "Input",
InitializationCell->True]
}, Open ]]
}, Closed]]
}, Open ]],
Cell[73308, 1631, 135, 3, 42, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[73480, 1639, 283, 10, 159, "Section",
InitializationCell->True],
Cell[73766, 1651, 183, 4, 42, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[73974, 1659, 86, 2, 126, "Section",
InitializationCell->True],
Cell[CellGroupData[{
Cell[74085, 1665, 82, 2, 52, "Subsubsection",
InitializationCell->True],
Cell[74170, 1669, 436, 7, 92, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[74643, 1681, 83, 2, 39, "Subsubsection",
InitializationCell->True],
Cell[74729, 1685, 521, 8, 144, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[75287, 1698, 89, 2, 39, "Subsubsection",
InitializationCell->True],
Cell[75379, 1702, 299, 7, 85, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[75715, 1714, 101, 2, 52, "Subsubsection",
InitializationCell->True],
Cell[75819, 1718, 849, 17, 246, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[76705, 1740, 87, 2, 39, "Subsubsection",
InitializationCell->True],
Cell[76795, 1744, 409, 8, 142, "Input",
InitializationCell->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[77253, 1758, 76, 2, 69, "Section",
InitializationCell->True],
Cell[77332, 1762, 114, 3, 42, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[77471, 1769, 82, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[77556, 1773, 599, 11, 218, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[78192, 1789, 83, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[78278, 1793, 99, 3, 42, "Input",
InitializationCell->True],
Cell[78380, 1798, 2066, 38, 387, "Input",
InitializationCell->True],
Cell[80449, 1838, 852, 16, 193, "Input",
InitializationCell->True],
Cell[81304, 1856, 958, 18, 193, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[82299, 1879, 89, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[82391, 1883, 475, 11, 153, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[82903, 1899, 101, 2, 53, "Subsubsection",
InitializationCell->True],
Cell[83007, 1903, 1420, 29, 474, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[84464, 1937, 87, 2, 38, "Subsubsection",
InitializationCell->True],
Cell[84554, 1941, 506, 9, 168, "Input",
InitializationCell->True]
}, Closed]]
}, Open ]],
Cell[85087, 1954, 136, 3, 42, "Input",
InitializationCell->True]
}, Open ]]
}
]
*)
(*******************************************************************
End of Mathematica Notebook file.
*******************************************************************)