(************** 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[ 606288, 13934]*) (*NotebookOutlinePosition[ 607613, 13975]*) (* CellTagsIndexPosition[ 607569, 13971]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Generalized Knots in ", StyleBox["Mathematica", FontSlant->"Italic"], ". " }], "Title", PageWidth->PaperWidth, FontSize->24], Cell["Representation & elementary analysis of Curves & Knots.", "Subtitle", PageWidth->PaperWidth, FontSize->16], Cell[TextData[{ "R.H.Beresford. 24/8/5.\n ", StyleBox["\"Programming should lead to understanding, simplification & \ generalization.\"", FontSize->12] }], "Subsubtitle", FontSize->14], Cell[TextData[{ StyleBox["Summary.\n", FontSize->18], "Knots, braids, bends, links, hitches, weaves etc. are described by \ d-dimensional space-curves. Their projections can be shown as 2D shadows, \ 2.5D knot diagrams, and 3D tubes using piece-wise cubic interpolation. \ Mathematical knots and links are closed 3D lines that cannot be untangled \ without passing lines through lines. Braids provide compact knot descriptors; \ bends join two ropes; hitches and binding knots are tied round posts etc.; \ many are illustrated. A small database is included; the larger K2K database \ can be accessed. Elementary knot creation procedures, basic knot-analysis \ procedures, and a gallery of knot-graphs are supplied, together with a \ glossary and some key knot references (several on-line).\nActivate the \ following cell and respond \"yes\"." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(<< "\"; << \ "\"; Off[General::"\", General::"\", Part::"\", Do::"\", Graphics::"\", First::"\"]; tf = TraditionalForm;\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[TextData[{ StyleBox["Evaluate the tiny cell (below, right\[LowerRightArrow]) and \ expand the result to page width to see some\n\t\t\t", FontFamily->"Times New Roman"], "\t\t", StyleBox["Illustrations.", FontSize->16, FontWeight->"Bold"] }], "Text", PageWidth->PaperWidth, FontFamily->"Courier New", FontSize->9], Cell[BoxData[ \(sK = Show[curvs[perturb[simple], rad \[Rule] .8, twist \[Rule] 2, chordno \[Rule] 2], V003, DI, BF, PlotLabel -> "\"]; sC = crossings[]; Show[GraphicsArray[{{Show[curvs[4\ sq], DI, PlotLabel -> "\"], \ \[IndentingNewLine]Show[curvs[borrom], ViewPoint \[Rule] { .5, \(-2\), .5}, DI, BF, PlotLabel -> "\"], Show[sK]}, {Show[curvs[ringBraid[bGord], chordno \[Rule] 1], V003, DI, BF, PlotLabel -> "\"], ShowGraph[kg08[\([6]\)], DI, PlotLabel -> "\"], Show[sC, DI, PlotLabel -> "\"]}, {Show[ curvs[braid[b08[\([3]\)]]], V003, DI, BF, PlotLabel -> "\< Braid\nb08[[3]]\>"], Show[curvs[weave22, rad \[Rule] .15], V003, DI, BF, PlotLabel -> "\"], Show[curvs[hunters], V003, DI, BF, PlotLabel -> "\"]}}]]; sC =. ; sK =. ;\)], "Input", PageWidth->PaperWidth, CellOpen->False], Cell[TextData[{ "WARNING. This notebook has not been thoroughly tested, and may still \ contain serious errors. ", StyleBox["knotGraph ", FontSlant->"Italic"], "fails for links and a few knots. Corrections will follow as they are \ discovered." }], "Text", PageWidth->PaperWidth, FontSize->9], Cell["\<\ Revision of download from \ http://library.wolfram.com/infocenter/MathSource/5608/\ \>", "Text", FontSize->9], Cell[CellGroupData[{ Cell["1. Introduction.", "Section", PageWidth->PaperWidth, FontSize->18], Cell[CellGroupData[{ Cell["1.1. Space-curves.", "Subsection"], Cell[TextData[{ "\tIn this notebook, Space-curves are smooth lines passing through \ sequences of d-dimensional ", StyleBox["points", FontSlant->"Italic"], " (sets of ", StyleBox["d", FontSlant->"Italic"], " coordinates) with the slope at each point defined as that of the line \ joining the neighbouring points. Piece-wise cubic interpolation is used to \ subdivide the ", StyleBox["segments", FontSlant->"Italic"], " (between ", StyleBox["points", FontSlant->"Italic"], ") into", StyleBox[" chords", FontSlant->"Italic"], ", so that a curve can be defined by a few points, and then interpolated in \ detail. This allows local changes; altering a point only affects local \ segments. A ", StyleBox["tension", FontSlant->"Italic"], " option controls the interpolation; infinite tension would give straight \ lines between the points. Curves can be closed (\"loops\") with the last \ point coinciding with the first, or open (\"threads\"). Tubes can be created \ with curves as core-lines. Single non-intersecting loops may be knots or \ unknots; multiple loops may be linked or unlinked." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["1.2. Knots, Braids, Knot Graphs.", "Subsection"], Cell[TextData[{ "\t\"Mathematical knots\" are non-intersecting 3-D space-curve loops that \ cannot be converted to unknots (simple loops) without passing curves through \ each other; a mathematician cannot tie a knot in a rubber band! Many standard \ knots are included (as closed space curves) in the Named Knots section, with \ names k", StyleBox["0c00n", FontSlant->"Italic"], " (to match [1], ", Cell[BoxData[ \(TraditionalForm\`c\_n\)]], " is used in [4] & [5]) indicating the ", StyleBox["n", FontSlant->"Italic"], "'th knot with ", StyleBox["c", FontSlant->"Italic"], " crossings in the simplest ", StyleBox["knot diagram", FontSlant->"Italic"], " (the projection onto a plane with overpasses marked).\n\t\"Shadows\" are \ (2D) projections of space curves onto a plane, with crossings or \"nodes\" \ identified.\n\tKnot diagrams are shadows with vertical information (2.5D) to \ indicate the over- and under-crossing lines at each node\n\tBraids are sets \ of \"parallel\" lines with crossings between adjacent lines; joining them \ end-to-end creates links that may be knots.\n\tKnot Graphs have edges passing \ through each vertex on a knot diagram. b", StyleBox["0c00n & ", FontSlant->"Italic"], "kg", StyleBox["0c00n ", FontSlant->"Italic"], "are the braid and knot graph representations corresponding to k", StyleBox["0c00n", FontSlant->"Italic"], "." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["1.3. Data, Presentation.", "Subsection"], Cell[TextData[{ "\tI define generalized knots as sets of ", StyleBox["d", FontSlant->"Italic"], "-dimensional space-curves, and include 2 & 3D links, knots, hitches, \ bends, braids & weaves. Links consist of more than one loop, and need not be \ knotted; some small examples are included. Many generalized knots are \ defined; some are cross-referenced to illustrations in [2] or [4], e.g. \ A1425a corresponds to Ashley's fig 1425a.\n\tSection 6.7 is database of \ simple knots and links with up to 9 crossings, based on Eric Weisstein's 2003 \ Knots.m database [8]. This includes the Conway notation, which can be used by \ (rudimentary) ", StyleBox["kconway", FontSlant->"Italic"], " to create some knots as spacecurves. \n\tThe non-", StyleBox["Mathematica", FontSlant->"Italic"], " \"KnotPlot\" [3] is much more sophisticated than this notebook. \ Interfacing routines are provided to K2K, Ochiai's encyclopaedic ", StyleBox["Mathematica", FontSlant->"Italic"], " knot package. This provides many key routines as .exe routines (including \ interactive graphical input of knots), and includes Thistlethwaite's database \ (nearly 700000 knots and braids with 9 to 16 crossings).\n\t", StyleBox["Knots_etc.nb", FontSlant->"Italic"], " provides a basic, accessible, ", StyleBox["Mathematica", FontSlant->"Italic"], " package and database for curves, tubes & knots, together with interfaces \ to other packages. It supplies procedures to plot generalized knots in the \ following formats- \n(1) As ordinates against length.\n(2) As 2-D \"shadows\" \ and 2.5D \"knot diagrams\" projected onto any pair of dimensions. These can \ be compared with [1] and [4,Appendix].\n(3) As lines or tubes in 3D plots, \ with a choice of projection coordinates when d>3. Tube surfaces can have \ twisted surface meshes.\n(4) As (1st-angle or 3rd-angle) projections together \ with a general view.\n(5) As \"braids\", \"ring-braids\", and \ \"loop-braids\".\n(6) As Knot Graphs.\n(7) As K2K braid & knot plots.\n\tKnot \ diagrams and braids have \"crossings\" and are the subject of much \"knot \ theory\". Elementary knot theory procedures are demonstrated, analysing ", StyleBox["nodeLists", FontSlant->"Italic"], ". (Knot polynomials can be calculated if K2K is available.)" }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["1.4. Data Structures.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tThe basic data structure is a ", StyleBox["linelist", FontSlant->"Italic"], " containing some ", StyleBox["lines", FontSlant->"Italic"], " as sets of d-dimensional ", StyleBox["points", FontSlant->"Italic"], ". Sections 5, 6, & 7 contain many (mainly hand-made) examples. Procedures \ ", StyleBox["braid, loopBraid", FontSlant->"Italic"], " & ", StyleBox["ringbraid", FontSlant->"Italic"], " create a ", StyleBox["linelist", FontSlant->"Italic"], " from a ", StyleBox["braidlist", FontSlant->"Italic"], ", which is a braid word expressed as a list of integers (identifying the \ braid line that moves up one position, negated if it is an underpass); ", StyleBox["bword", FontSlant->"Italic"], " is the (interchangeable) K2K equivalent.", "\n\tThe ", StyleBox["curvs", FontSlant->"Italic"], " procedure uses piece-wise local cubic interpolation to convert a ", StyleBox["linelist", FontSlant->"Italic"], " into ", StyleBox["xyz", FontSlant->"Italic"], ", a more detailed set of coordinates that are joined by ", StyleBox["chords.", FontSlant->"Italic"], " This can be plotted as 2D & 3D lines or as 3D tubes, using ", StyleBox["Show[ curvs[ linelist, curvOptions], GraphicsOptions];", FontSlant->"Italic"], ".\n\t ", StyleBox["xyz", FontSlant->"Italic"], " is reduced by ", StyleBox["crossings", FontSlant->"Italic"], " to a set of 2.5D ", StyleBox["nodes", FontSlant->"Italic"], " (positions with overpass information where lines cross in a 2D \ projection). These are listed as ", StyleBox["nodeList", FontSlant->"Italic"], ", a list of the two crossing indices at each crossing. ", StyleBox["nodeList", FontSlant->"Italic"], " is signed to indicate the overpass and the crossing orientation and is \ used in all the knot & link analysis procedures. ", StyleBox["chxyz", FontSlant->"Italic"], " is the location of the revised chord start points; ", StyleBox["gcurv", FontSlant->"Italic"], " include depth and index information. ", StyleBox["Show[gcurv]", FontSlant->"Italic"], " plots the chords with indexed nodes.\n\tKnots2000(K2K) use ", StyleBox["bword", FontSlant->"Italic"], " and ", StyleBox["pdata,", FontSlant->"Italic"], " which can be created by ", StyleBox["blistToBword", FontSlant->"Italic"], " and ", StyleBox["nodeListToPword", FontSlant->"Italic"], "; their inverses create KnotsEtc data.\n\t Knot graphs are sets of ", StyleBox["vertices", FontSlant->"Italic"], " (one per black region of the chequered diagram) joined by ", StyleBox["edges", FontSlant->"Italic"], " wherever two black regions meet at a node. Two plots, shown by ", StyleBox["Show[kgshow] ", FontSlant->"Italic"], "&", StyleBox[" ShowGraph[ kgraf],", FontSlant->"Italic"], " are created by ", StyleBox["knotGraph[ nodeList]", FontSlant->"Italic"], "; the first superimposes the graph on the shadow, with edges through \ nodes; the second is in ", StyleBox["Combinatorica", FontSlant->"Italic"], " format. The database contains \"rectified\" graphs ", StyleBox["kg0c00n ", FontSlant->"Italic"], "for many knots; these have the vertices on a basically square grid.\n\tFor \ Mathematica 3 compatibility, Mod should be replaced by Mod1 and Rest by \ restv3:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(restv3[l_List] := Drop[l, {1}]\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(Mod1[i_, j_] := Mod[i - 1, j] + 1\)], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["1.5. Revisions.", "Subsection", PageWidth->PaperWidth], Cell["\<\ Preliminary version, spacecurvknots, April 2005. 17/6/5. This was replaced by KnotsEtc. 18/6/5. Minor corrections; closure eliminated when r=0. Symmetric bends \ added. 25/7/5. More bends added. Gordian braid, illustration, tying instructions \ added. New section on Hitches. kConway improved. ringBraid OK for links. 24/8/5. Links to K2K included and demonstrated.\ \>", "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["2. Tutorial.", "Section", PageWidth->PaperWidth, FontSize->18], Cell[CellGroupData[{ Cell["2.1. 2D plots, piecewise cubic interpolation.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tShow[curvs[2DList]]", StyleBox[" uses piecewise cubic interpolation to create and plot a curve in \ the form of (straight-line) chords interpolated between the points given in ", FontSlant->"Plain"], "2DList", StyleBox[", closing the loop smoothly if the first and last points \ coincide", FontSlant->"Plain"], ". ", StyleBox["The slope at each point is that between the neighbours of the \ point", FontSlant->"Plain"], ".", StyleBox[" A 2D plot is drawn, with each point numbered and marked by a \ dot. (Higher dimensional plots are discussed below.) ", FontSlant->"Plain"] }], "Text", PageWidth->PaperWidth, FontSlant->"Italic"], Cell[BoxData[ RowBox[{ RowBox[{"(*", RowBox[{"Example", " ", "1.", StyleBox["circling", FontSlant->"Plain"], StyleBox[" ", FontSlant->"Plain"], StyleBox["the", FontSlant->"Plain"], StyleBox[" ", FontSlant->"Plain"], StyleBox["square", FontSlant->"Plain"]}], StyleBox["*)", FontSlant->"Plain"]}], RowBox[{ RowBox[{ RowBox[{ RowBox[{ StyleBox["Print", FontSlant->"Plain"], StyleBox["[", FontSlant->"Plain"], RowBox[{ StyleBox["{", FontSlant->"Plain"], RowBox[{ StyleBox["\"\\"", FontSlant->"Plain"], StyleBox[",", FontSlant->"Plain"], StyleBox["sq", FontSlant->"Plain"], StyleBox[",", FontSlant->"Plain"], "\"\<\\nThe line is a closed loop because the last and \ first point coincide.\>\""}], "}"}], "]"}], ";"}], "\[IndentingNewLine]", \(Show[curvs[sq, chordno \[Rule] 3]]\)}], ";"}]}]], "Input", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["\tThe appearance of the plot can be altered by a number of ", FontSlant->"Plain"], StyleBox["options.", FontSlant->"Italic"], StyleBox["\n\t", FontSlant->"Plain"], "A ", StyleBox["chordno", FontSlant->"Italic"], " option sets the number of chords per segment; here there are 4 segment; \ each is split into 3 chords and so there are 12 chords. (Alternatively, the \ average reciprocal length of each chord can be set by making ", StyleBox["chordno", FontSlant->"Italic"], " a real number.)", StyleBox[" \n\tAnother option is ", FontSlant->"Plain"], StyleBox["tension", FontSlant->"Italic"], StyleBox["; the default value of 1 \"circles the square\" to give a \ pseudo-circle (a good visual approximation to a circle) when the points are \ corners of a square.", FontSlant->"Plain"], "\n\tSetting the option ", StyleBox["showlist", FontSlant->"Italic"], "\[RightArrow]{0} gives a plot of the ordinates of the interpolation. The \ first point duplicates the last in closed curves, and so is not plotted; \ changing ", StyleBox["chordno", FontSlant->"Italic"], " to 10 gives a smooth appearance at this scale:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", \(Example\ 2. Ordinate\ Plot\), StyleBox["*)", FontSlant->"Plain"]}], " ", "\[IndentingNewLine]", \(Show[ curvs[sq, showlist \[Rule] {0}, chordno \[Rule] 10]];\)}]], "Input",\ PageWidth->PaperWidth], Cell[TextData[{ "\tIncreasing tension (via options ", StyleBox["tension->1.5 ", FontSlant->"Italic"], "etc) gives shorter lines between the points and sharper corners, infinite \ tension would correspond to linear interpolation. Values less than 1 \ correspond to internal pressure, inflating the line. Appendix A goes into \ details. Whilst squares have circular approximations when ", StyleBox["tension", FontSlant->"Italic"], "=1, other regular polygons need other values. This is demonstrated for an \ equilateral triangle with ", StyleBox["tension\[Rule]1", FontSlant->"Italic"], " (the inner plot), with ", StyleBox["tension", FontSlant->"Italic"], "\[Rule]", StyleBox[".6,chordno->3", FontSlant->"Italic"], " (the inscribed nonagon) and with ", StyleBox["tension", FontSlant->"Italic"], "\[Rule]", StyleBox[".6,chordno->8", FontSlant->"Italic"], ". This is just distinguishable from the circumcircle, which is also \ plotted. (The ", StyleBox["tension ", FontSlant->"Italic"], "parameter can be used to improve the fit between the chord ends and the \ true circles, or the look of a plot. It is kept at 1 in most sections of this \ notebook.) " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{\( (*Example\ 3. \ Equilateral\ triangle\ fits\ a\ circle\ with\ \ tension \[Rule] .6; \ fewer\ chords\ are\ used\ for\ clarity*) \), RowBox[{\(equilat = {{{\(-\@3\)/2, \(-1\)/2}, {0, 1}, {\@3/2, \(-1\)/2}, {\(-\@3\)/2, \(-1\)/2}}}\), ";", RowBox[{"Show", "[", RowBox[{ StyleBox[\(curvs[4 equilat, chordno -> 8]\), FontSlant->"Plain"], StyleBox[",", FontSlant->"Plain"], StyleBox[\(curvs[4 equilat, tension \[Rule] .6, chordno -> 3]\), FontSlant->"Plain"], StyleBox[",", FontSlant->"Plain"], StyleBox[\(curvs[4 equilat, tension \[Rule] .6, chordno -> 10]\), FontSlant->"Plain"], StyleBox[",", FontSlant->"Plain"], \(Graphics[Circle[{0, 0}, 4]]\)}], "]"}], ";"}]}]], "Input", PageWidth->PaperWidth], Cell[TextData[{ "\tPlotting options can be used, between the closing bracket of ", StyleBox["curvs", FontSlant->"Italic"], " and that of ", StyleBox["Show", FontSlant->"Italic"], ". Adding ", StyleBox["Axes->True", FontSlant->"Italic"], " in Example 4 shows that a right-angle triangle {0,1},{1,0},{-1,0}, with", StyleBox[" tension\[Rule].6", FontSlant->"Italic"], ", gives a pseudo-ellipse through the three specified points." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ "(*", \(Example\ 4. Right - angle\ Triangle\ gives\ a\ pseudo - ellipse\ with\ tension \[Rule] .6\), StyleBox["*)", FontSlant->"Plain"]}], \(Show[ curvs[tri = {{{0, 1}, {1, 0}, {\(-1\), 0}, {0, 1}}}, tension \[Rule] .6], Axes \[Rule] True];\)}]], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.2. Plotting higher-dimensional spacecurves.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tSpace-curves can have any number of dimensions, but can only be plotted \ in 2D or 3D. Example 5 shows a line traversing the corners of a hypercube, \ projected onto different 3D spaces (specified by ", StyleBox["showlist\[Rule]{1,2,3}", FontSlant->"Italic"], " etc). The corners are perturbed to prevent overlapping lines. In the \ first, traversing a hypercube gives a sort of 4D \"tennis-ball seam\"; the \ second has cusps that are projections of curves in the \"other\" dimension ." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 5. \ wxy\ projection\ of\ hypercube\ traversal*) \ \)\(Show[curvs[ph = perturb[hypercube4, .1], chordno \[Rule] 6. , showlist \[Rule] {1, 2, 3}, rad \[Rule] 0], Axes \[Rule] False];\)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 6. \ wxz\ projection\ of\ the\ same\ hypercube\ \ traversal, \ with\ more\ chords, \ drawn\ as\ a\ thin\ 3 D\ \(\(tube\)\(.\)\)*) \)\(Show[ curvs[ph, showlist \[Rule] {1, 2, 4}, rad \[Rule] .05, chordno \[Rule] 4], Boxed \[Rule] False];\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.3. 3D plots as lines or tubes.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tCurves in any number of dimensions can be projected as 2D lines onto any \ pair of directions, but they are usually easier to understand when plotted as \ 3D tubes, as in Example 6. Options can be applied, such as ", StyleBox["twist->3", FontSlant->"Italic"], " which rotates the tube longitudinal mesh 3 times. The viewpoint can be \ changed from the standard one (used in Ex.6.) via a Graphics3D ", StyleBox["ViewPoint", FontSlant->"Italic"], " option such as ", StyleBox["ViewPoint\[Rule]{0,0,9}", FontSlant->"Italic"], "; note the capital P and the position outside the ", StyleBox["curvs[] ", FontSlant->"Italic"], "instruction; it can be abbreviated to V009, one of several pre-programmed \ abbreviations.\n\t 3D objects can also be shown as \"engineering drawings\" \ together with the standard view, by ", StyleBox["firstAngle[]", FontSlant->"Italic"], " & ", StyleBox["thirdAngle[]", FontSlant->"Italic"], ". (I have not found any way to making the projection sizes match.) The \ simple knot is illustrated, as a line, as a plan view of a twisted tube, and \ as a third-angle projection:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 7. \ Simple\ Knot\ as\ a\ line\ with\ node\ and\ \ overcross\ markers, \ as\ a\ twisted\ tube, \ and\ as\ \(\(projections\)\(.\)\)*) \)\(\[IndentingNewLine]\)\(\(Show[ curvs[simple, rad -> 0], AF];\)\[IndentingNewLine] \(Show[curvs[simple, twist \[Rule] 3], V009, BF];\)\[IndentingNewLine] \(Show[thirdAngle[simple]];\)\)\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "\tMultiple lines are handled by ", StyleBox["curvs", FontSlant->"Italic"], StyleBox["[{{line1},{line2}...}]", FontSlant->"Italic"], " and can be drawn as lines or tubes. Selected lines can be shown by \ listing separate curves. Three ellipses, arranged as Borromean rings, are \ shown in Example 8. The three are interlocked, but are pairwise free, as can \ be seen from the pairwise plots:- " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 8. \ Borromean\ Rings\ are\ not\ pair - wise\ \(\(linked\)\(.\)\)*) \)\(Show[ GraphicsArray[{{Show[curvs[borrom], DisplayFunction -> Identity, BF, V291], \[IndentingNewLine]Show[ curvs[{borrom[\([1]\)], borrom[\([2]\)]}], DI, BF, V291]}, {Show[curvs[{borrom[\([3]\)], borrom[\([1]\)]}], DI, BF, V291], Show[curvs[{borrom[\([3]\)], borrom[\([2]\)]}], DI, BF, V291]}}]];\)\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "\tThe format for GraphicsArray requires ", StyleBox["DisplayFunction->Identity", FontSlant->"Italic"], " (abbreviated to DI) in every ", StyleBox["Show", FontSlant->"Italic"], " instruction, because ", StyleBox["DisplayFunction", FontSlant->"Italic"], " is reset by ", StyleBox["curvs", FontSlant->"Italic"], ". BF is an abbreviation for ", StyleBox["Boxed->False", FontSlant->"Italic"], ". V291 sets a suitable viewpoint." }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "\t\"Local options\" can be set by including them ahead of the line to \ which they apply. The data for ", StyleBox["hitch1", FontSlant->"Italic"], " sets the radii and number of lines round the perimeter for both \ \"posts\"; and then sets the radius for the \"rope\". The standard options \ are restored for each new line, and overwritten by local options:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 9. *) \)\(hitch1\[IndentingNewLine] \(Show[thirdAngle[hitch1]];\)\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.4. Braids & weaves.", "Subsection", PageWidth->PaperWidth], Cell["\<\ \tKnots and links can be shown as \"closed braids\". Many authors show them \ as threads running down the page [4], [6]; in this notebook and in [5] they \ run left-to-right. The convention is that the threads are joined end-to-end, \ so that Example 10 corresponds to a link with two \"strands\", as the second \ up from the bottom joins to itself.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 10. \ 4 - thread\ Braid\ representing\ two\ closed\ loops*) \)\(\ \[IndentingNewLine]\)\(Show[curvs[braid4b], V009, BF];\)\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "\tExample 11 corresponds to a 4-braid forming a single strand (Conway's \ knot). It is described by a ", StyleBox["braidlist", FontSlant->"Italic"], ". This ", StyleBox["Mathematica", FontSlant->"Italic"], "-compatible form is obtained from the \"braid word\" that descrbes this \ knot, ", Cell[BoxData[ \(TraditionalForm\`\(\[Sigma]\_2\%3\) \(\[Sigma]\_1\) \ \(\[Sigma]\_3\%\(-1\)\) \(\[Sigma]\_2\%\(-2\)\) \(\[Sigma]\_1\) \(\[Sigma]\_2\ \%\(-1\)\) \(\[Sigma]\_1\) \[Sigma]\_3\%\(-1\)\)]], ", by converting to a list of signed subscripts \ {2,2,2,1,-3,-2,-2,1,-2,1,-3}. (Moody, according to [4,p208], would write this \ [22213'2'2'1213']). I then rotate this to give a standard \"largest\" \ (normalized) case. The knot is also shown as a ", StyleBox["loopBraid", FontSlant->"Italic"], ", my name for the standard closure, and as a ", StyleBox["ringBraid", FontSlant->"Italic"], ". A ", StyleBox["linelist ", FontSlant->"Italic"], "is created by appropriate procedures from the ", StyleBox["braidlist", FontSlant->"Italic"], ", allowing standard knot analysis procedures of section 2.7 to be applied \ to braids." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 11. \ Conway' s\ knot\ as\ a\ 4 - strand\ Braid, \ a\ loopBraid, \ and\ a\ ringBraid\ *) \)\(\[IndentingNewLine]\)\(Show[ curvs[braid[b11con]], V003, BF]; Show[curvs[loopBraid[b11con]], V003, BF]; Show[curvs[ringBraid[b11con]], V003, BF];\)\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "\tSection 6 contains a normal ", StyleBox["braidlist", FontSlant->"Italic"], " for every simple knots with up to 8 crossings, together with some larger \ knots; many of these have more crossings than the knot that they represent. \ Example 12 shows a normalized braid for knot k08003, which needs 5 threads \ and 10 crossings." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 12. k08003\ Normalized\ \(\(braid\)\(.\)\)*) \)\(Show[ curvs[braid[b08[\([3]\)]], rad \[Rule] .2], V003, BF];\)\)\)], "Input", PageWidth->PaperWidth], Cell["\<\ Weaves have threads crossing in different directions. Different under/over \ sequences give patterned weaves such as the Herrinbone weave; weaves are not \ restricted to threads in two directions:- \ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 13. Weaves*) \)\(Show[ GraphicsArray[{{Show[curvs[weave22, rad \[Rule] .2], ViewPoint \[Rule] {0, 0, 9}, DI, BF], Show[curvs[weave77a], ViewPoint \[Rule] {0, 1, 3}, DI, BF], Show[curvs[weave436], ViewPoint \[Rule] {0, 1, 3}, DI, BF]}}]];\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.5. Bends.", "Subsection", PageWidth->PaperWidth], Cell["\<\ \tIn the knot fraternity bends join ropes etc. so they have two threads, each \ with a short end and a long end or \"standing part\". Many are listed (as \ knots) in [10], with illustrations and tying instructions. Ashley [3] \ illustrates over 150 bends, and discusses the reliability of some of them. To \ him, \"a different form, a different way of tying, or a different use \ constitutes a different knot\". He points out that a knot must first be tied, \ and then \"worked\" (drawn up into shape), because there are very few knots \ that take up the desired form on simply pulling the ends; many will \"capsize\ \" or just give an untidy mess. Different knots may be obtained, in some \ cases, by \"working\" differently. I generally show the \"tied\" rather than \ the \"worked\" form; Ashley would probably damn my illustrations as \"of \ theoretical interest\". \tExample 14 shows a few bends. The Reef knot is often used as a bend, but is \ unreliable. The Granny is worse. The Thief's knot is a reef in which the long \ and short ends of one rope are exchanged - it comes undone on pulling gently. \ The Grief knot (not shown) is a reversed-pull Granny. The Whatnot is tricky \ in round material, but becomes the Grassbend, A1490, when tied in flat \ material. The Sheetbend (also called the Weaver's knot) is excellent, and can \ be streamlined as the tucked sheet bend. The doubled overhand knot takes two \ forms. It is first shown as the Ring (or Gut) knot; this is good for stiff \ and slippery material such as gut. The binder knot (A1410) has the same \ topology but the working ends are adjacent strands; it distorts to the \ asymmetric form under tension. It is tied by machines such as hay or straw \ binders.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(Example\ 14. \ Some\ bends . \ Activate\ the\ tiny\ cell\)\(\ \)\(\[LowerRightArrow]\)*) \)], \ "Input", Evaluatable->False], Cell[BoxData[ \(\(Show[ GraphicsArray[{{Show[curvs[reef3d2], V009, DI, BF, PlotLabel -> "\"], Show[curvs[granny], V009, DI, BF, PlotLabel -> "\"]}, {Show[curvs[thiefs], V009, DI, BF, PlotLabel -> "\"], Show[curvs[whatnot], V009, DI, BF, PlotLabel -> "\"]}, {Show[curvs[sheetbend], V009, DI, BF, PlotLabel -> "\"], Show[curvs[tuckedSheetBend], V009, DI, BF, PlotLabel -> "\"]}, {Show[curvs[ringKnot1], V009, DI, BF, PlotLabel -> "\"], Show[curvs[binderKnot], V009, DI, BF, PlotLabel -> "\"]}}]];\)\)], "Input", PageWidth->PaperWidth, FontSize->9], Cell["\<\ \tAshley comments that \"Dr Hunter's Bend\", A1425a, Example 15, which had a \ lot of publicity in the late 1970's (stimulating my interest in the subject) \ was also described by P.D.Smith in the 1950's.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 15. \ Hunter' s\ bend\ A1425a*) \)\(Show[ thirdAngle[hunters]];\)\)\)], "Input", PageWidth->PaperWidth], Cell["\<\ \t This publicity led me two study \"linked overhand bends\". These have an \ overhand knot (open trefoil knot) in each rope, with (often symmetrical) \ intertwining of the two ropes. Two shadows are relevant; they divide the \ plane into areas which I label a (above), b (below), c (centre), l (right), r \ (right), u (up), d (down):-\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(Example\ 16. \ Identification\ of\ areas\ in\ overhand\ knots . \ Activate\ the\ tiny\ cell\)\(\ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ \ \ \ \ *) \)], "Input", PageWidth->PaperWidth, Evaluatable->False], Cell[BoxData[{ \(\(t1DI = Show[{curvs[{{{\(-2\), 0, 0}, {\(-1\), 1, \(-1\)}, {0, 2, 1}, {1, 2, 0}, {1, 1, \(-1\)}, {0, 0, 0}, {\(-1\), 1, 1}, {\(-1\), 2, 0}, {0, 2, \(-1\)}, {1, 1, 1}, {2, 0, 0}}}, rad \[Rule] 0] /. pts \[Rule] {}, Graphics[{Text["\", {0, 2.3}], Text["\", {0, \(- .3\)}], Text["\", {0, 1}], Text["\", {\(-1\), 1.5}], Text["\", {1, 1.5}]}]}, DI, Axes \[Rule] False];\)\), "\n", \(\(t2DI = Show[{curvs[{{{\(-3\), 0, 0}, {\(-2\), 0, 1}, {0, 0, \(-1\)}, {1, .2, 0}, {2, 1, \(-1\)}, {1, 2, 0}, { .2, 1, 1}, {\(- .2\), 0, \(-1\)}, {\(-1\), \(-1\), 1}, {\(-2\), 0, \(-1\)}, {\(-1\), .8, 0}, {0, 1, 1}, {2, 1, \(-1\)}, {3, 1, 0}}}, rad \[Rule] 0] /. pts \[Rule] {}, Graphics[{Text["\", {\(-1\), 1.3}], Text["\", {1, 1.3}], Text["\", {\(-1\), .4}], Text["\", {1, .6}], Text["\", {\(-1\), \(- .4\)}], Text["\", {1, \(- .4\)}]}]}, DI, Axes \[Rule] False];\)\), "\n", \(\(Show[GraphicsArray[{{t1DI, t2DI}}]];\)\)}], "Input", CellOpen->False], Cell["\<\ \tMany bends can now be prescribed by a list of these letters. An upper-case \ letter indicates that the short end of the RH rope passes UP through the \ corresponding area in the (right-handed) overhand knot in the LH rope, a \ lower-case letter indicates that it passes down through the area. The RH \ overhand is right-handed unless the prescription is negated. \ Double-left-handed knots are ignored. Knots can be created by holding a RH \ overhand in the left hand and passing the other rope through in sequence, \ using symmetry to complete the knot. This is rarely the best way to tie the \ knot; [10] explains how to tie many of them. \t\"C\" is the Fisherman's bend (Waterknot), and \"-c\" is a variation \ (Waterknotx), whilst \"c\" and \"-C\" are lumpy (not shown). Hunter's bend is \ \"CaR\". Example 17 shows more examples, in the worked form, with their \ prescriptions.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(Example\ 17. \ Some\ Linked\ overhand\ bends . \ Activate\ the\ tiny\ cell\)\(\ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ \ \ \ *) \)], "Input", Evaluatable->False], Cell[BoxData[ \(\(Show[ GraphicsArray[{{Show[curvs[waterKnot], V009, DI, BF, PlotLabel -> "\"], Show[curvs[waterKnotx], V009, DI, BF, PlotLabel -> "\"]}, {Show[ curvs[zeppelinKnot /. a -> 0, rad \[Rule] .4], V009, DI, BF, PlotLabel -> "\"], Show[curvs[rL], V009, DI, BF, PlotLabel -> "\"]}, {Show[ curvs[gord, rad \[Rule] .3], V009, DI, BF, PlotLabel -> "\"], Show[curvs[CaR], V009, DI, BF, PlotLabel -> "\"]}, {Show[ curvs[MW2, rad \[Rule] .3], V009, DI, BF, PlotLabel -> "\"], Show[curvs[lBr], V009, DI, BF, PlotLabel -> "\"]}}]];\)\)], "Input", PageWidth->PaperWidth, CellOpen->False, FontSize->9], Cell["\<\ \tThe Zeppelin knot (developed to secure the mooring ropes for Zeppelin \ airships) is easily and reliably tied and easily untied. My \"Gordian knot\" \ is the opposite, tedious to tie, but very difficult to untie (except in \ low-friction material) once it has been tightened so thoroughly that the \ central tunnel is closed. CaR may be new. It does not jam.\ \>", "Text", PageWidth->PaperWidth], Cell["\<\ \tTo tie the Gordian Knot, hold an overhand knot with the left thumb over all \ three crossings, with the end on top on the left, and with the left and right \ openings just large enough for the rope to pass through twice. Pass the second rope up through the left opening, to the right above the \ thumb, and up through both the right and left openings. (It runs alongside \ another piece of rope each time.) Next pass it under the thumb (to the right \ again), and up through the right opening, inside two ropes. Tighten each end \ progressively, adjusting to give the symmetrical appearence. When this shape \ is achieved, hold the knot and pull each rope several times in turn, and \ finish off with several strong jerks (or should I say yanks?) \tA skilled (and patient) knotter could use one rope, short-splice the free \ ends after tying, and work the knot until the splice is completely hidden \ inside the knot. The knot can also be tied \"on the table\", using the ringbraid (shown on the \ front page) as a guide, and pulling out the arcs at 4 o'clock and 10 o'clock. \tAshley shows a \"Turkish Lanyard Knot\" (A796) which may be a badly drawn \ version of this knot (his top right strand is wrong) but gives no details.\ \>", "Text", PageWidth->PaperWidth, FontFamily->"Times New Roman"] }, Closed]], Cell[CellGroupData[{ Cell["2.6. Hitches and Binding knots.", "Subsection", PageWidth->PaperWidth], Cell["\<\ Hitches and Binding knots are similar, in that they are tightened round a \ post or round a convex object, such as the neck of a bag, that needs \ constricting or binding. Most hitches are used with a pull at right angles to \ the axis; a different style is needed for axial pulls - timber hitches and \ rolling hitches. Tree surgeons and mountaineers have hitches that can slide \ when not loaded, but are firm when used as a stirrup. \ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(\(Example\ 18. \ Some\ Right - angle - pull\ Hitches\ &\)\ Binding\ Knots . \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ Activate\ the\ tiny\ cell\)\(\ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ \ \ \ *) \)], "Input", Evaluatable->False], Cell[BoxData[ \(\(Show[ GraphicsArray[{{Show[curvs[hitch2], DI, BF, PlotLabel -> "\"], Show[curvs[constrictor], ViewPoint \[Rule] {0, 4, \(-2\)}, DI, BF, PlotLabel -> "\"]}, {Show[ curvs[singlepass], ViewPoint \[Rule] {0, \(-2\), 4}, DI, BF, PlotLabel -> "\"], Show[curvs[boa], ViewPoint \[Rule] {0, 2, 4}, DI, BF, PlotLabel -> "\"]}}]];\)\)], "Input", PageWidth->PaperWidth, CellOpen->False, FontSize->9], Cell[BoxData[ \( (*\(\(Example\ 19. \ Some\ Axial - pull\ Hitches\ &\)\ Binding\ Knots . \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ Activate\ the\ tiny\ cell\)\(\ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ \ \ \ *) \)], "Input", Evaluatable->False], Cell[BoxData[ \(\(Show[ GraphicsArray[{{Show[curvs[Magnus, rad \[Rule] .25], ViewPoint \[Rule] {\(-5\), \(-5\), 3}, DI, BF, PlotLabel -> "\"], Show[curvs[Prusik], ViewPoint \[Rule] {\(-5\), \(-5\), 3}, DI, BF, PlotLabel -> "\"]}}]];\)\)], "Input", PageWidth->PaperWidth, CellOpen->False, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["2.7. Links.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["Links are multiple loops. The Borromean links were shown in \ Example 8.", FontSlant->"Plain"], "\nkn[n] ", StyleBox["creates four sorts of space curve. If ", FontSlant->"Plain"], "n", StyleBox[" is odd, the circular knot of ", FontSlant->"Plain"], "n", StyleBox[" crossings is produced. If ", FontSlant->"Plain"], "n", StyleBox[" is even, two linked loops are produced. These have 2", FontSlant->"Plain"], "n", StyleBox[" crossings if they have the same centre. One loop may be given an \ ", FontSlant->"Plain"], "x", StyleBox[" displacement, giving either two (Hopf links) or no (separated \ links) crossings:- ", FontSlant->"Plain"] }], "Text", PageWidth->PaperWidth, FontSlant->"Italic"], Cell[BoxData[ \( (*\(\(Example\ 20. \ Links\ &\)\ Circular\ \(\(knots\)\(.\)\)\)\(\ \ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ *) \)], "Input", Evaluatable->False], Cell[BoxData[{ \(kn2 = Show[curvs[kn[2], rad \[Rule] .4], DI, BF, V009]; kn3 = Show[curvs[kn[3], rad \[Rule] .4], DI, BF, V009]; kn4 = Show[curvs[kn[4], rad \[Rule] .4], DI, BF, V009]; knk = Show[curvs[kn[2, 1, \(- .1\), 1], rad \[Rule] .2], DI, BF, V009];\), "\[IndentingNewLine]", \(\(Show[GraphicsArray[{{kn2, kn3}, {kn4, knk}}]];\)\)}], "Input", PageWidth->PaperWidth, CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell["2.8. Crossings, Knot Diagrams, Knot Analysis.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tKnots and links can be analysed after they have been created by ", StyleBox["curvs loopbraid, ", FontSlant->"Italic"], "or", StyleBox[" ringbraid", FontSlant->"Italic"], ". These create lists ", StyleBox["xyz", FontSlant->"Italic"], " of chord-end coordinates, which can be analysed (slowly if ", StyleBox["chordno", FontSlant->"Italic"], " is >2) for crossing points of the line(s) in the knot shadow. This is \ done by ", StyleBox["crossings[],", FontSlant->"Italic"], " which assigns indices to each crossing and re-plots the knot, together \ with the two indices. The overcrossing index is placed above the \ undercrossing index. To minimize coincidences that lead to ill-conditioned \ matrices (common when curves are specified in terms of points with integral \ coordinates), the knot may first be perturbed by ", StyleBox["perturb[list_, f_:.001]", FontSlant->"Italic"], ", which randomly adds or subtracts to each ordinate a displacement of up \ to ", StyleBox["f", FontSlant->"Italic"], " of the knot maximum dimension.\n\t", StyleBox["crosscurv[List_] ", FontSlant->"Italic"], "provides a short-cut that does the same analysis, calling ", StyleBox["curvs & crossings", FontSlant->"Italic"], " with the appropriate options (including perturbation), plotting the \ labelled diagram, and finally calling ", StyleBox["linkMatrix", FontSlant->"Italic"], " and ", StyleBox["dowth", FontSlant->"Italic"], ". These are printed if the print parameter ", StyleBox["pr", FontSlant->"Italic"], " is 1 (linkMatrix), 2 (writhe), or 3 (both). The plot is suppressed if \ pr<0.\n\tThe results are stored in ", StyleBox["nodeList", FontSlant->"Italic"], " (a global variable). This can be converted to the Dowker-Thistlethwaite \ name by ", StyleBox["dowth[],", FontSlant->"Italic"], " a list of the even-numbered crossings (nodes) in the sequence that they \ cross the odd numbered nodes. It has been used, according to [4,p40], to list \ all knots of up to 13 crossings. (I normalize this to the \"largest\" name by \ choice of starting node.) If K2K is available (Section 2.14), Knots (but not \ links) can be plotted from the Dowker-Thistlethwaite name, as in Example 21.\n\ \t", StyleBox["writhe[]", FontSlant->"Italic"], " calculates the number of positive crossings minus the number of negative \ crossings, positive being when the overpass is left-to-right as seen from the \ entering underpass. The ", StyleBox["linkMatrix", FontSlant->"Italic"], " is a count of the crossings between different links. The counts below the \ diagonal are the total, the others being signed sums accounting for crossing \ orientation, with the diagonal giving the ", StyleBox["writhe ", FontSlant->"Italic"], "for each link.\n\t ", StyleBox["bridgeCount[]", FontSlant->"Italic"], " counts the number of bridges in a diagram (its minimum, the ", StyleBox["bridgenumber", FontSlant->"Italic"], ", is a knot invariant that is difficult to find). " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*\(Example\ 21. \ A\ 7 crossing\ knot\ analysed\ for\ crossings\ &\)\ Dowker - Thistlethwaite\ name, \ writhe, \ \(\(&\)\(\ \)\(drawn\)\(\ \)\(by\)\(\ \)\(K2K\)\)*) \)\(\ \[IndentingNewLine]\)\(Show[ K72 = curvs[perturb[k07002, .0001], rad \[Rule] .5, chordno \[Rule] 2], BF, V009]; Show[crossings[]]; {"\", nodeList, "\<\nDowker-Thistlethwaite name = \>", \[IndentingNewLine]DT \ = dowth[nodeList], "\<\nWrithe =\>", \[IndentingNewLine]writhe[]}\ \[IndentingNewLine] ShowKnotfromPdata[KnotbyDT[DT]]; DT =. \)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 22. \ A\ 7 crossing\ unknot\ analysed\ by\ \(\(crosscurv\)\(.\)\)*) \)\(\ \[IndentingNewLine]\)\(Show[ u7 = curvs[perturb[unknot7, .001], rad \[Rule] .2, chordno \[Rule] 2], BF, V009]; pr = 3; crosscurv[unknot7]; pr = 0;\)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", RowBox[{ RowBox[{"Example", " ", "23.", " ", StyleBox["twolink", FontSlant->"Italic"], " ", "analysed", " ", "for", " ", "crossings"}], ",", " ", \(Dowker - Thistlethwaite\ \(\(name\)\(.\)\)\)}], "*)"}], "\[IndentingNewLine]", \(Show[ curvs[perturb[twolink, .01], rad \[Rule] .1, chordno \[Rule] .2], V009, BF]; Show[crossings[]]; {"\", nodeList, \[IndentingNewLine]"\", dowth[]}\)}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", RowBox[{ RowBox[{"Example", " ", "24.", " ", StyleBox["links888", FontSlant->"Italic"], " ", "analysed", " ", "for", " ", "crossings"}], ",", " ", \(Dowker - Thistlethwaite\ name\), ",", " ", \(\(writhe\)\(.\)\)}], "*)"}], \(pr = 3; Show[curvs[perturb[links888, .001], rad \[Rule] .1, chordno \[Rule] 3], V009]; crosscurv[links888]; pr = 0; {"\", dowth[], "\<\nWrithe\>", \[IndentingNewLine]writhe[]}\)}]], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.9. Knot Diagram Simplification.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tThe three Reidermeister moves [4,p13],[5,p3],[6,p16] alter knot diagrams \ without altering the knot topology. They can be used to simplify an untidy \ knot, by removing crossings until a minimum-crossing diagram is obtained. \ They can also show that two diagrams represent the same knot. Unfortunately, \ there is no strategy that ensures success here, and thousands of moves may be \ needed in a proof. Their importance is that procedures built from \ Reidermeister moves cannot alter the knot topology, and so may lead to knot \ invariants such as the bracket polynomials.\n\tTwo \"unknots\" are reduced to \ the simple unknot in the next examples. The sequence of moves to use is a \ matter of trial and error.\n\tThe K2K ", StyleBox["ReductionKnotLink.exe ", FontSlant->"Italic"], "procedure simplifies knots in ", StyleBox["pldata", FontSlant->"Italic"], " format. (It presumably has some limitations, but Example 41. correctly \ reduces a 34-crossing knot, obtained from a braid, to a 16 crossing knot.)" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 25. \ A\ 3 crossing\ unknot\ is\ reduced\ by\ R2\ *) \)\(Show[ curvs[perturb[unknot3, .0001], chordno \[Rule] 2], V009, BF]; Show[crossings[]]; {"\", nodeList, "\<\nR1[R2[]] reduces this to the unknot \>", R1[R2[]]}\)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*\(Example\ 26. \ A\ 7 crossing\ unknot\ is\ reduced\ by\ R3\ &\)\ R2*) \)\(crosscurv[ unknot7]; {"\", nodeList, "\<\nand R1[R2[R2[]]] gives the unknot \>", R1[R2[R2[]]]}\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.10. 4D curves", "Subsection", PageWidth->PaperWidth], Cell["\<\ \tAny number of dimensions can be handled by the procedures in this notebook, \ but little use has been made of this facility. A 4D curve is shown in various \ projections. The LH plots show a tube projected into the 3D-spaces (missing \ dimensions 1, 2, 3, & 4 in turn); the other plots are projections onto the \ other three planes:-\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(Example\ 27. \ Projections\ of\ a\ 4 D\ space\ \(\(curves\)\(.\)\)\)\(\ \ \ \ \ \)\(\[LowerRightArrow]\)\ \ *) \)], "Input", Evaluatable->False], Cell[BoxData[{ \(t234 = Show[curvs[simple4, showlist \[Rule] {2, 4, 3}], DI, BF, V009]; k234 = Show[curvs[simple4, showlist \[Rule] {2, 3, 4, 1}, rad \[Rule] 0], DI, AF, PlotLabel -> "\"]; k342 = Show[curvs[simple4, showlist \[Rule] {3, 4, 2, 1}, rad \[Rule] 0], DI, AF, PlotLabel -> "\"]; k423 = Show[curvs[simple4, showlist \[Rule] {4, 2, 3, 1}, rad \[Rule] 0], DI, AF, PlotLabel -> "\"];\[IndentingNewLine]\), "\ \[IndentingNewLine]", \(t134 = Show[curvs[simple4, showlist \[Rule] {3, 1, 4}], DI, BF, V009]; k134 = Show[curvs[simple4, showlist \[Rule] {1, 3, 4, 2}, rad \[Rule] 0], DI, AF, PlotLabel -> "\"]; k341 = Show[curvs[simple4, showlist \[Rule] {3, 4, 1, 2}, rad \[Rule] 0], DI, AF, PlotLabel -> "\"]; k413 = Show[curvs[simple4, showlist \[Rule] {4, 1, 3, 2}, rad \[Rule] 0], DI, AF, PlotLabel -> "\"];\[IndentingNewLine]\ \[IndentingNewLine]\), "\[IndentingNewLine]", \(t124 = Show[curvs[simple4, showlist \[Rule] {1, 2, 4}], DI, BF, V009]; k124 = Show[ curvs[simple4, showlist \[Rule] {1, 2, 4, 3}, rad \[Rule] 0] /. pts \[Rule] {}, DI, AF, PlotLabel -> "\"];\), "\[IndentingNewLine]", \(k241 = Show[curvs[simple4, showlist \[Rule] {2, 4, 1, 3}, rad \[Rule] 0] /. pts \[Rule] {}, DI, AF, PlotLabel -> "\"]; k412 = Show[ curvs[simple4, showlist \[Rule] {4, 1, 2, 3}, rad \[Rule] 0] /. pts \[Rule] {}, DI, AF, PlotLabel -> "\"];\[IndentingNewLine]\), \ "\[IndentingNewLine]", \(t123 = Show[curvs[simple4, showlist \[Rule] {1, 2, 3}], DI, BF, V009]; k123 = Show[ curvs[simple4, showlist \[Rule] {1, 2, 3, 4}, rad \[Rule] 0] /. pts \[Rule] {}, DI, AF, PlotLabel -> "\"]; k231 = Show[ curvs[simple4, showlist \[Rule] {2, 3, 1, 4}, rad \[Rule] 0] /. pts \[Rule] {}, DI, AF, PlotLabel -> "\"]; k312 = Show[ curvs[simple4, showlist \[Rule] {3, 1, 2, 4}, rad \[Rule] 0] /. pts \[Rule] {}, DI, AF, PlotLabel -> "\"];\), "\[IndentingNewLine]", \(\(Show[ GraphicsArray[{{t234, k234, k342, k423}, {t134, k134, k341, k413}, {t124, k124, k241, k412}, {t123, k123, k231, k312}}]];\)\)}], "Input", PageWidth->PaperWidth, CellOpen->False, FontSize->9], Cell[TextData[{ "\tThe output with rad\[RightArrow]0 allows curves to be modified, as each \ point is numbered unless \"/.pts\[Rule]{},\" is included. Piece-wise cubic \ interpolation ensures that changes are local. I attempted to make ", StyleBox["simple4", FontSlant->"Italic"], " into a knot in all four subspaces, but failed with ", StyleBox["t134", FontSlant->"Italic"], "." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.11. Curve and Knot Rotations.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tThe matrices rx3, rx4, ry3, ry4, rz3, rz4, etc. rotate single lines of \ the indicated dimensionality by the specified anticlockwise angle. rxyz3 & \ rxyz4 rotate ", StyleBox["lineLists", FontSlant->"Italic"], "; different lines are extracted from the list, rotated, and then put back \ into a list:- " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 28. \ Rotating\ the\ simple\ knot*) \)\(\ \[IndentingNewLine]\)\(Show[curvs[simple], V090, BF]; Show[curvs[{simple[\([1]\)] . ryz[\[Pi]/4, .2]}], V090, BF]; Show[curvs[rxyz3[borrom, \[Pi]/3, 1, .1]], V090, BF];\)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 29. \ Rotating\ both\ parts\ of\ the\ weavers\ knot*) \ \)\(Show[curvs[{weavers[\([1]\)] . ryz[\[Pi]/3, .2], weavers[\([2]\)] . ryz[\[Pi]/3, .2]}, rad \[Rule] .1], V009, BF];\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.12. Gallery of Knot Graphs.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\t In a \"chequered knot diagram\" the outside is white and each line \ separates black and white regions. Knot graphs have a vertex in each black \ region and an edge through each node shared by black regions; they are planar \ graphs. The edges take the sign (orientation) of their nodes, shown as black \ or red in this implementation.\n\tTo create a graph from a ", StyleBox["lineList", FontSlant->"Italic"], ", a knot diagram must first be created by ", StyleBox["crosscurv", FontSlant->"Italic"], " (NOT ", StyleBox["crossings", FontSlant->"Italic"], ", because this does not perturb the points, and so may give \ ill-conditioned diagrams). ", StyleBox["kgraf ", FontSlant->"Italic"], "(a graph in the ", StyleBox["Combinatorica", FontSlant->"Italic"], " format) is created. It can be shown by ", StyleBox["ShowGraph[knotGraph[par]];", FontSlant->"Italic"], ". The graph can also be shown superimposed on the knot ", "shadow", ", with edges distorted to pass through the corresponding vertices, by ", StyleBox["Show[kgshow];", FontSlant->"Italic"], ". The parameter ", StyleBox["par", FontSlant->"Italic"], " scales the vertices to improve ", StyleBox["kgshow", FontSlant->"Italic"], " appearance; it has to be negated if a positive value makes the wrong \ regions black, as in Example 30. The correct graph is obtained with +ve ", StyleBox["par", FontSlant->"Italic"], " in most of the ", StyleBox["lineLists", FontSlant->"Italic"], " in this notebook.\n\tVertices with a single edge can be eliminated \ (Reidermeister type 1 move). Different coloured edge pairs between the same \ vertices can be eliminated (Reidermeister type 2 move). A Reidermeister type \ 3 move eliminates a vertex with 3 edges, replacing it with a new edge forming \ a \[CapitalDelta], or vice-versa. This can be used to minimize the number of \ vertices.\n\tThe procedure relies on there being only one line in the \ diagram, so it fails for ", StyleBox["links", FontSlant->"Italic"], "." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(Example\ 30. \ Knot\ Graphs\ for\ \(\(k10129\)\(.\)\)\)\(\ \ \ \ \ \ \ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ *) \)], "Input", PageWidth->PaperWidth, Evaluatable->False], Cell[BoxData[{\(crosscurv[k10129];\), "\n", RowBox[{\(knotGraph[1]\), ";", \(Show[kgshow, AF]\), ";", RowBox[{ "Print", "[", "\"\\"Italic\"]\).\\nNote that knot graphs have \ multiple edges wherever white regions have only two nodes.\>\"", "]"}], ";"}], "\n", \(ShowGraph[knotGraph[\(-1.5\)]]; Show[kgshow, AF]; Print["\"]; \ ShowGraph[kg10129];\)}], "Input"], Cell[TextData[{ "\t\"Tidy\" knotgraphs ", StyleBox["kg0c00n", FontSlant->"Italic"], " and ", StyleBox["kgc[[n]]", FontSlant->"Italic"], " are supplied for all simple knots with up to 8 vertices, for a few larger \ knots, and for a few composite knots ", StyleBox["bcn1 n2", FontSlant->"Italic"], " (these have single vertices between the components ", StyleBox["n1", FontSlant->"Italic"], " & ", StyleBox["n2", FontSlant->"Italic"], "). The graphs with multiple edges are \"rectified\" so that, as far as \ possible, the most complex edge is at the bottom left. Stored graphs usually \ have more +ve than -ve edges.\n\tUnresolved problem - vertices do not always \ show up in the gallery if edges are collinear, so some graphs have had to be \ distorted." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*\(Example\ 31. \ Knot\ Graphs\ \(\(Gallery\)\(.\)\)\)\(\ \ \ \ \ \ \ \ \ \ \ \ \ \)\(\[LowerRightArrow]\)\ *) \)], "Input", Evaluatable->False], Cell[BoxData[ RowBox[{ RowBox[{"Show", "[", RowBox[{"GraphicsArray", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{\(ShowGraph[kg31, DI, PlotLabel -> "\"]\), ",", \(ShowGraph[kg41, DI, PlotLabel -> "\"]\), ",", RowBox[{"ShowGraph", "[", RowBox[{"kg05001", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"5\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"1\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg05002", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"5\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"2\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg06001", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"6\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"1\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg06002", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"6\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"2\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{"kg06003", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"6\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"3\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg06c33", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"3\",\nFontSize->10]\)\!\(\* StyleBox[\"#3\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg06n33", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"3\",\nFontSize->10]\)\!\(\* StyleBox[\"#3\",\nFontSize->10]\)\!\(\* StyleBox[\"a\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg07c34", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"3\",\nFontSize->10]\)\!\(\* StyleBox[\"#4\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([1]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"1\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([2]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"2\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([3]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"3\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([4]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"4\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([5]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"5\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([6]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"6\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg07[\([7]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([1]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"1\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([2]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"2\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([3]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"3\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([4]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"4\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([5]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"5\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([6]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"6\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([7]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"7\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([8]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([9]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"9\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([10]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"10\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([11]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"11\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([12]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"12\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([13]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"13\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([14]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"14\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([15]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"15\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([16]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"16\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([17]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"17\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([18]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"18\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([19]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"19\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([20]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"20\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([21]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"21\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([22]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"4\",\nFontSize->10]\)\!\(\* StyleBox[\"#4\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{\(kg08[\([23]\)]\), ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"8\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"4\",\nFontSize->10]\)\!\(\* StyleBox[\"#4\",\nFontSize->10]\)\!\(\* StyleBox[\"a\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg09023", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\" \",\nFontSize->10]\)\!\(\* StyleBox[\"9\",\nFontSize->10]\)\!\(\* StyleBox[\",\",\nFontSize->10]\)\!\(\* StyleBox[\"23\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg1000a", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\"1000\",\nFontSize->10]\)\!\(\* StyleBox[\"a\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"ShowGraph", "[", RowBox[{"kg10104", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\"10104\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg10105", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\"10105\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg10129", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\"10129\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg10161", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\"10161\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg11255", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K\",\nFontSize->10]\)\!\(\* StyleBox[\"11255\",\nFontSize->10]\)\>\""}]}], "]"}], ",", RowBox[{"ShowGraph", "[", RowBox[{"kg11257", ",", "DI", ",", RowBox[{"PlotLabel", "->", "\"\<\!\(\* StyleBox[\"K11257\",\nFontSize->10]\)\>\""}]}], "]"}]}], "}"}]}], "}"}], "]"}], "]"}], ";"}]], "Input", PageWidth->PaperWidth, CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell["2.13. Conway Notation (rudimentary).", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tConway [9] developed a compact notation that prescribes a knot or link. \ It is based on the replacement of the vertices of \"basic polyhedra\" \ (4-regular graphs without 2-vertex regions) by \"4-tangles\" (a link region \ with four free ends). The description in [4, Section 2.3] is over-simplified, \ being restricted to the small knots obtained by closing a single tangle above \ and below - i.e. placing the tangle at the crossing of an 8, which is the \ 1-vertex polyhedron.\n\tTangles are described by a list of integers denoting \ the specified number of twists (left-handed if negated by a trailing - sign) \ of two strands; successive twists are horizontal and vertical, joined \ alternately above or to the right. (This is equivalent [4, p44, reversed] to \ Conway's \"flips\" about the NW-SE axis.) Example - the tangle \"42\" has 4 \ horizontal crossings surmounted by two vertical crossings, giving k06001 when \ the ends are joined.\n\tContinued-fractions can be calculated from the \ reverse of these lists. Conway proves that tangles giving the same fraction \ are equivalent, so the simplest equivalent (consisting of positive integers \ apart from the last which may be negative) can be chosen as a standard.\n\tHe \ defines nine polyhedra, 1*, 6*, 6**, 8*, 9*, 10*, 10**, 10*** & 11*; these \ are sufficient for diagrams with up to 11 crossings. The notation for each \ diagram starts with the polyhedron name (implicitly for 1*, 6* and 6**) \ followed by tangle lists for each vertex.\n\tHe uses a lot of confusing \ abbreviations - a comma for a zero, a full stop for a 1, a colon for two 1's \ (?? the explanation is unclear); trailing 1's are shown as + (or omitted for \ 8* etc where they are the default); minus signs negate the previous integer \ for 1* knots but mean -1 in the other cases. A leading full stop implies 6**; \ 6* is implied by non-leading full stops. Composite knots are indicated, as \ usual, by #; these are excluded from his tables. A comma or zero gives a \ second flip, cancelling the first, so that the direction is maintained, but a \ displacement occurs (giving a pretzel).\n\t", StyleBox["ConwayUnpack[string,True/False]", FontSlant->"Italic"], " unpacks a basic string, giving the continued fraction if ", StyleBox["True", FontSlant->"Italic"], " is specified. " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 32\ Two\ equivalent\ fractions\ and\ two\ 11 - crossing\ knots\ as\ fractions\ *) \)\(\(ConwayUnpack["\<23-2\>", True];\)\[IndentingNewLine] \(ConwayUnpack["\<2111\>", True];\)\[IndentingNewLine] \(ConwayUnpack["\<42,3,2-\>", True];\)\[IndentingNewLine] \(ConwayUnpack["\<41,22,21\>", True];\)\)\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "\tOnly the basic Conway notation, a string of up to 3 integers, is \ implemented as ", StyleBox["kConway", FontSlant->"Italic"], ". " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \( (*Example\ 33. \ A\ 5 - crossing\ knot\ as\ a\ diagram\ and\ a\ tube; \(\(6 - crossing\ 2 - link\)\(\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \)\(\[LowerRightArrow]\)\)*) \)], "Input", PageWidth->PaperWidth, Evaluatable->False], Cell[BoxData[ RowBox[{\(pr = 0\), ";", RowBox[{"res", "=", RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", "\"\<32\>\"", "]"}]}], ";", RowBox[{"res1", "=", RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", "\"\<222\>\"", "]"}]}], ";", \(Show[ GraphicsArray[{{Show[ curvs[res, rad \[Rule] 0, chordno \[Rule] 4, tension \[Rule] 2] /. pts \[Rule] {}, DI, AF], Show[curvs[res, rad \[Rule] .3, chordno \[Rule] 4, tension \[Rule] 2], V003, DI], Show[curvs[res1, rad \[Rule] 0, chordno \[Rule] 4, tension \[Rule] 2] /. pts \[Rule] {}, DI, AF]}}]]\), ";"}]], "Input", CellOpen->False], Cell[BoxData[ \( (*\(\(Example\ 34. \ Links\ &\)\ Knots\ from\ Conway\ notation\)\(\ \ \)\(\[LowerRightArrow]\)*) \)], "Input", PageWidth->PaperWidth, Evaluatable->False], Cell[BoxData[{ RowBox[{\(pr = 0\), ";", RowBox[{"kn2", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{"curvs", "[", RowBox[{ RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", "\"\<2\>\"", "]"}], ",", \(rad \[Rule] .2\), ",", \(tension \[Rule] 2\)}], "]"}], ",", "DI", ",", "V009"}], "]"}]}], ";", RowBox[{"kn3", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{"curvs", "[", RowBox[{ RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", "\"\<3\>\"", "]"}], ",", \(rad \[Rule] .2\), ",", \(tension \[Rule] 2\)}], "]"}], ",", "DI", ",", "V009"}], "]"}]}], ";", RowBox[{"kn4", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{"curvs", "[", RowBox[{ RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", "\"\<34\>\"", "]"}], ",", \(rad \[Rule] .4\), ",", \(tension \[Rule] 2\)}], "]"}], ",", "DI", ",", "V009"}], "]"}]}], ";", RowBox[{"knk", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{"curvs", "[", RowBox[{ RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", "\"\<332\>\"", "]"}], ",", \(rad \[Rule] .4\), ",", \(tension \[Rule] 2\)}], "]"}], ",", "DI", ",", "V009"}], "]"}]}], ";"}], "\[IndentingNewLine]", \(Show[ GraphicsArray[{{kn2, kn3}, {kn4, knk}}]];\)}], "Input", CellOpen->False], Cell[TextData[{ "\t", StyleBox["kConway ", FontSlant->"Italic"], "should create Pretzels, but this has not been implemented; ", StyleBox["kpretzel", FontSlant->"Italic"], " is demonstrated:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 35. \ kpretzel\ demo*) \)\(res = kpretzel[{3, 3, 2}]; Show[GraphicsArray[{{Show[ curvs[res, rad \[Rule] 0, chordno \[Rule] 2] /. pts \[Rule] {}, AF, DI], Show[curvs[res, rad \[Rule] .3, chordno \[Rule] 2], V003, DI, BF]}}]];\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.14. Knots via K2K.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tThe routines in Section 3.9. link ", StyleBox["K2K", FontSlant->"Italic"], " and ", StyleBox["KnotsEtc", FontSlant->"Italic"], ". They are demonstrated in the following examples." }], "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["2.14.1 Graphical input of knots via K2K.", "Subsubsection", PageWidth->PaperWidth], Cell[TextData[{ "\tUse ", StyleBox["name=", FontSlant->"Italic"], " ", StyleBox["GetPdatabyTracking[] ", FontSlant->"Italic"], "to input or revise a knot (or link) diagram in a mouse-tracking window. \ The resulting ", StyleBox["pdata", FontSlant->"Italic"], " will be stored as ", StyleBox["name", FontSlant->"Italic"], " so that it can be investigated by other functions. \n\n", StyleBox["Instructions.", FontWeight->"Bold"], "\n\tLeft-click in the \"Knot and Link\" window to start a new link. Move \ to the next point and left click. Add points as needed, using the DEL key to \ back-track if necessary. Close the link by clicking on the first point. Other \ links can then be added. Left-click on any crossing to reverse under/over. A \ right click produces an instructions window. The top instruction \"Draw a \ Knot Link\"shows the tidied-up knot as a tube, together with a black window; \ clearing the black window (or pressing ESC) returns to the plot. When \ satisfied with the diagram, press w or W (write) to store it in the file ", Cell[BoxData[ StyleBox[\(\(L astPLdata\) . pl\), FontWeight->"Plain"]], "Input", FontSlant->"Italic"], " (which can be inspected by !!LastPLdata.pl). Use the bottom \"Quit\" \ instruction (or use ESC; DO NOT use the red X).\n\nUse Ex.36 to create and \ store a trefoil knot:-" }], "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[BoxData[ \(\(\( (*Example\ 36\ *) \)\(k36 = GetPdatabyTracking[]\[IndentingNewLine] ShowKnotfromPdata[k36]\)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \({{3}, {4, 6, 2}}\)], "Output"] }, Closed]], Cell["\<\ The previous diagram is restored (erasing anything in the window) by \ pressing r or R (read). Use it to recover your trefoil and add another knot \ linked with the trefoil (you may need several delete-redraw and under/over \ corrections):-\ \>", "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[BoxData[ \(\(\( (*Example\ 37\ *) \)\(k37 = GetPdatabyTracking[]\n ShowKnotfromPdata[k37]\)\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \({{7, 6}, {\(-15\), \(-25\), 7, 13, \(-19\), \(-21\), 5, \(-2\), 23, \(-10\), \(-8\), 17, \(-14\)}}\)], "Output"] }, Closed]], Cell["\<\ The following command shows a pdata knot and allows rotation and distortion \ to change the outer domin via left-clicking in an internal region. Quit by q, \ ESC, or right click.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(ShowKnotbyOpengl[{{7, 6}, {\(-15\), \(-25\), 7, 13, \(-19\), \(-21\), 5, \(-2\), 23, \(-10\), \(-8\), 17, \(-14\)}}];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(?ShowKnotbyOpengl\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["2.14.2 K2K Knots from braidlist.", "Subsubsection", PageWidth->PaperWidth], Cell[TextData[{ "Routines interconvert between ", StyleBox["braidlist", FontSlant->"Italic"], " (KnotsEtc) and ", StyleBox["bword", FontSlant->"Italic"], " (K2K); graphs shown as ", StyleBox["ringBraids", FontSlant->"Italic"], " can be converted to K2K-style knot diagrams as follows:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 38. \ braidList \[RightArrow] bword \[RightArrow] K2K\ knot\ *) \)\(\(Show[ curvs[ringBraid[{3, 3, \(-1\), \(-2\), 3, 3, 1, \(-2\), 3, \(-1\), \(-1\)}]], V009];\)\[IndentingNewLine] bl = blistToBword[{3, 3, \(-1\), \(-2\), 3, 3, 1, \(-2\), 3, \(-1\), \(-1\)}]\[IndentingNewLine] bwdtonumwd[bl]\[IndentingNewLine] ShowKnotfromPdata[k38 = KnotFromBraid[bl]]\)\)\)], "Input", PageWidth->PaperWidth], Cell["See Example 41, which finds braids from the databank.", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["2.14.3 K2K Knots and lineList via crosscurv.", "Subsubsection", PageWidth->PaperWidth], Cell[TextData[{ "KnotsEtc data can be converted to K2K format via ", StyleBox["crosscurv ", FontSlant->"Italic"], "& ", StyleBox["nodeListToPdata", FontSlant->"Italic"], ". and then shown via ", StyleBox["ShowKnotfromPdata. ", FontSlant->"Italic"], "K2KShow", " combines these in one instruction." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\( (*Example\ 39. \ lineList \[RightArrow] nodeList \[RightArrow] K2K\ knot\ *) \)\(pr = \(-1\) (*\ Suppresses\ crosscurvplot\ *) ; crosscurv[k08005]; n08005 = nodeList\[IndentingNewLine] p08005 = nodeListToPdata[n08005]\[IndentingNewLine] ShowKnotfromPdata[p08005]\[IndentingNewLine] K2KShow[k09023]\[IndentingNewLine] p08005 =. ; n08005 =. ;\)\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["2.14.5 K2K Knots from Thistlethwaite Data.", "Subsubsection", PageWidth->PaperWidth], Cell["\<\ The plist can be found for 201691 non-alternate knots with 10 to 15 \ crossings:-\ \>", "Text"], Cell[BoxData[ \(\(\( (*Example\ 40. \ The\ 999 th\ 15 - crossing\ non - alternate\ knot\ *) \)\(\[IndentingNewLine]\)\(p15999 = plistFromK2K[15, 999]\[IndentingNewLine] \(ShowKnotfromPdata[p15999];\)\)\)\)], "Input"], Cell[TextData[{ "The ", StyleBox["ShowKnotfromPdata", FontSlant->"Italic"], " procedure should have been modified to create a ", StyleBox["lineList \"ll\" ", FontSlant->"Italic"], "if the parameter", StyleBox[" p ", FontSlant->"Italic"], "is 3. This creates a lineList ", StyleBox["ll", FontSlant->"Italic"], " for the knot so that KnotsEtc routines can be applied:-" }], "Text"], Cell[BoxData[ \(\(\( (*Example\ 41. \ lineList\ from\ K2K\ knot\ *) \ \)\(\(ShowKnotfromPdata[p15999, 3];\)\[IndentingNewLine] Show[crossings[ll]]; ShowGraph[knotGraph[\(-3\)]];\[IndentingNewLine] ll =. ; p15999 =. ;\)\)\)], "Input"], Cell[TextData[{ StyleBox["bword", FontSlant->"Italic"], " can be found for 83 knots with 4 to 9 crossings (from Weisstein's data) \ and 426213 non-alternate knots (from Thistlethwaite's data) with 10 to 16 \ crossings. The knot can be drawn as a ringbraid or as an unreduced K2K knot; \ ", StyleBox["ReductionKnotLink", FontSlant->"Italic"], " finds a simple version.", " The example has 34 crossings but reduces to 16. " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", RowBox[{\(Example\ 42. \ The\ 999 th\ 16\), "-", \(crossing\ non\), "-", RowBox[{"alternate", " ", "knot", " ", "via", " ", StyleBox["bword", FontSlant->"Italic"]}]}], "*)"}], "\[IndentingNewLine]", \(bw16999 = blist[16, 999]\[IndentingNewLine] b16999 = bwdtonumwd[bw16999]\[IndentingNewLine] Length[b16999]\[IndentingNewLine] \(Show[curvs[ringBraid[b16999], chordno \[Rule] 2], V009, BF];\)\[IndentingNewLine] ShowKnotfromPdata[p16999 = KnotFromBraid[bw16999]]\[IndentingNewLine] p16999\[IndentingNewLine] ShowKnotfromPdata[ r16999 = ReductionKnotLink[p16999]]\[IndentingNewLine] Length[r16999[\([2]\)]]\[IndentingNewLine] bw16999 =. ; b16999 =. ; p16999 =. ; r16999 =. ;\)}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["2.15. Knot Polynomials via K2K.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tBracket polynomials are Laurent polynomials (i.e. with positive and \ negative integer indices), weighted signed sums of powers of one or more \ variables. They are calculated recursively by using Reidermeister moves (so \ they are invariants for unoriented knots) to \"splice\" the knot into ", Cell[BoxData[ \(TraditionalForm\`2\^c\)]], " \"states\", and summing contributions from each state. Taking orientation \ into account leads to the Jones Polynomial; this distinguishes between most \ knots and links. K2K provides procedures to calculate these and the older \ Alexander and Conway polynomials." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{\( (*Example\ 43. \ trefoil\ polynomials*) \), "\[IndentingNewLine]", RowBox[{\(x =. ; t =. ; k36 = {{3}, {\(-5\), \(-1\), \(-3\)}};\), "\n", StyleBox[\(KauffmanPolynomial[k36]\), FontWeight->"Bold"], StyleBox["\[IndentingNewLine]", FontWeight->"Bold"], \(SkeinPolynomial[0, k36]\), "\[IndentingNewLine]", \(SkeinPolynomial[1, k36]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-1\), k36]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-2\), k36]\), "\[IndentingNewLine]", \(k36 =. ;\)}]}]], "Input", PageWidth->PaperWidth], Cell[TextData[{ "blist", StyleBox[" data is available for simple knots with up to 9 crossings as ", FontSlant->"Plain"], "genKnot[[c,n,6]]., ", StyleBox["and for larger knots from the", FontSlant->"Plain"], StyleBox[" K2K files. (It can also be found via ", FontSlant->"Plain"], "blist[cr,index].", StyleBox[") Create a knot and find the polynomials:-", FontSlant->"Plain"] }], "Text", PageWidth->PaperWidth, FontSlant->"Italic"], Cell[BoxData[ RowBox[{\( (*Example\ 44. \ k09013\ polynomials*) \), "\[IndentingNewLine]", RowBox[{\(p40 = KnotFromBraid[blistTobword[genKnot[\([9, 13, 6]\)]]]\), "\n", \(ShowKnotfromPdata[p40]\), "\[IndentingNewLine]", StyleBox[\(KauffmanPolynomial[p40]\), FontWeight->"Bold"], StyleBox["\[IndentingNewLine]", FontWeight->"Bold"], \(SkeinPolynomial[0, p40]\), "\[IndentingNewLine]", \(SkeinPolynomial[1, p40]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-1\), p40]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-2\), p40]\), "\[IndentingNewLine]", \(p40 =. \)}]}]], "Input", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["3. Curve, Knot, Braid Input and Display Routines. K2K links.", "Section", PageWidth->PaperWidth, FontSize->18], Cell[CellGroupData[{ Cell[TextData[{ "3.1. Plotting. ", StyleBox["curvs, perturb , thirdAngle, Vxyz etc.", FontSlant->"Italic"] }], "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[TextData[{ "Procedures ", StyleBox["curvs, perturb , thirdAngle, firstAngle.", FontSlant->"Italic"] }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ \(Clear[curvs, chordno, chono, d, p1, perimno, rad, sh, tension, twist, curvsFraming, curvsPrelude, showlist, perturb, thirdAngle, firstAngle]; pr = 0;\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"Options", "[", StyleBox["curvs", FontColor->RGBColor[0, 1, 0]], "]"}], "=", \({rad \[Rule] 1/4, chordno \[Rule] 3. , perimno \[Rule] 6, showlist \[Rule] {1, 2, 3}, tension \[Rule] 1, twist \[Rule] 0, PlotRange \[Rule] All, curvsFraming \[Rule] Normal, AspectRatio -> Automatic, Axes \[Rule] False, PlotStyle \[Rule] {Hue[ .7], Hue[ .3]}, curvsPrelude \[Rule] {}}\)}], ";", StyleBox[\( (*\ \(13/3\)/5\ Curves\ with\ local\ options, \ including\ \(\(tension\)\(.\)\)\ *) \), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{ RowBox[{ StyleBox["curvs", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(lines_?ListQ, opts___Rule : {}\), ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[":=", ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["Module", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox["{", ShowStringCharacters->True, NumberMarks->True], RowBox[{"c", ",", "ch", ",", "d", ",", StyleBox[\(dim = Length[lines[\([\(-1\), \(-1\)]\)]]\), ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], "l", ",", \(localopts = {opts}\), ",", "ls", ",", StyleBox["lt", ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], StyleBox["p1", ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], StyleBox["r", ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["sh", ShowStringCharacters->True, NumberMarks->True], StyleBox["=", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox["showlist", ShowStringCharacters->True, NumberMarks->True], "/.", \({opts}\)}], "/.", \(Options[curvs]\)}]}]}], "}"}], ",", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{\(If[Length[sh] > dim, sh = Take[sh, dim]]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[ Max[sh] > dim || Min[sh] < 0 || Length[Union[sh]] \[NotEqual] Length[sh], Print[{"\", sh}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(ls = Length[sh]\), ";", "\[IndentingNewLine]", StyleBox[\( (*Global\ variables*) \), FontColor->RGBColor[0, 0, 1]], StyleBox[\(xyz\ = \ {}\), ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(gcurv = {}\), ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(pts\ = \ {}\), ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], StyleBox[\($DisplayFunction\ = \ Identity\), ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["Do", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ RowBox[{ StyleBox["l", ShowStringCharacters->True, NumberMarks->True], StyleBox["=", ShowStringCharacters->True, NumberMarks->True], \(lines[\([i]\)]\)}], ";", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["For", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["each", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["element", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["of", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["lines", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], "\[IndentingNewLine]", RowBox[{"Switch", "[", RowBox[{\(Head[l]\), ",", "\[IndentingNewLine]", "Rule", ",", StyleBox[\( (*Local\ Options*) \), FontColor->RGBColor[0, 0, 1]], \(PrependTo[ localopts, l]\), ",", "\[IndentingNewLine]", "List", ",", RowBox[{ StyleBox[\(If[\(! MatrixQ[l]\), Print[{"\", lines (*\(//\)\(TraditionalForm\)*) }]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], "\[IndentingNewLine]", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["New", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(curve . \ Select\), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["showlist", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(dimensions?\ Apply\), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(options . \ Call\), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["spacecurve", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["If", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox[\(ls \[NotEqual] 1\), ShowStringCharacters->True, NumberMarks->True], StyleBox["&&", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["sh", ShowStringCharacters->True, NumberMarks->True], "\[NotEqual]", \(Range[dim]\)}]}], ",", \(lt = Transpose[l]; \[IndentingNewLine]l = {}; Do[PrependTo[l, lt[\([Abs[sh[\([j]\)]]]\)]], {j, ls}]; l = Transpose[l]\)}], "]"}], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\( (*\ Apply\ options\ *) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[{"\", Flatten[{localopts, Options[curvs]}]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", \({r, ch, pe, te, tw} = {rad, chordno, perimno, tension, twist} /. Flatten[{localopts, Options[curvs]}]\), ";", "\[IndentingNewLine]", \(If[ls < 3, r = 0]\), ";", StyleBox[\( (*2 D\ tubes\ not\ allowed*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(If[te < 1/4, te = 1/4]\), ";", StyleBox[\( (*Min\ tension\ to\ avoid\ cusps*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr > 8, Print[{"\", l, r, ch, sh, pe, te, tw}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(spacecurve[l, r, ch, sh, pe, te, tw]\), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox[";", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox[\(localopts = {opts}\), ShowStringCharacters->True, NumberMarks->True]}], ",", "\[IndentingNewLine]", "_", ",", StyleBox[\(Print[{"\", lines}]; Abort[]\), FontColor->RGBColor[1, 0, 1]]}], "]"}]}], ",", "\[IndentingNewLine]", StyleBox[\({i, Length[lines]}\), ShowStringCharacters->True, NumberMarks->True]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["Save", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["all", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["curves", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["in", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["gcurv", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontSlant->"Plain", FontColor->RGBColor[0, 0, 1]], StyleBox["and", FontSlant->"Plain", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontSlant->"Plain", FontColor->RGBColor[0, 0, 1]], StyleBox["allow", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["plotting", FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[\($DisplayFunction\ = \ Display[$Display, \ #1]\ &\), ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox[\({gcurv, pts}\), ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True]}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["perturb", FontColor->RGBColor[0, 1, 0]], "[", \(l_, del_: .001, s_: 8\), "]"}], ":=", \(Module[{jmax = Length[l[\([1, 1]\)]], imax, f = Flatten[l], dm, res = l}, dm = del\ \((Max[f] - Min[f])\); SeedRandom[s]; Do[Do[Do[ res[\([h, i, j]\)] += If[i \[NotEqual] 1 && i \[NotEqual] Length[l[\([h]\)]], dm \((2 Random[] - 1)\), 0], {j, jmax}], {i, Length[l[\([h]\)]]}], \[IndentingNewLine]{h, Length[l]}]; res]\)}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["thirdAngle", FontColor->RGBColor[0, 1, 0]], "[", \(k_, opts___Rule : {}\), "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({k22 = {{{}, {}}, {{}, {}}}, k1 = curvs[k, opts]}\), ",", RowBox[{ RowBox[{\(k22[\([1, 1]\)]\), "=", RowBox[{"Show", "[", RowBox[{ "k1", ",", \(ViewPoint \[Rule] {0, \(-999\), 0}\), ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", RowBox[{\(k22[\([1, 2]\)]\), "=", RowBox[{"Show", "[", RowBox[{ "k1", ",", \(ViewPoint \[Rule] {\(-999\), 0, 0}\), ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", RowBox[{\(k22[\([2, 1]\)]\), "=", RowBox[{"Show", "[", RowBox[{"k1", ",", \(ViewPoint \[Rule] {0, 0, 999}\), ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", RowBox[{\(k22[\([2, 2]\)]\), "=", RowBox[{"Show", "[", RowBox[{"k1", ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", StyleBox[\($DisplayFunction\ = \ Display[$Display, \ #1]\ &\), ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["GraphicsArray", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], "k22", "]"}]}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["firstAngle", FontColor->RGBColor[0, 1, 0]], "[", \(k_, opts___Rule : {}\), "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({k22 = {{{}, {}}, {{}, {}}}, k1 = curvs[k, opts]}\), ",", RowBox[{ RowBox[{\(k22[\([1, 1]\)]\), "=", RowBox[{"Show", "[", RowBox[{"k1", ",", \(ViewPoint \[Rule] {0, 999, 0}\), ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", RowBox[{\(k22[\([1, 2]\)]\), "=", RowBox[{"Show", "[", RowBox[{"k1", ",", \(ViewPoint \[Rule] {999, 0, 0}\), ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", RowBox[{\(k22[\([2, 1]\)]\), "=", RowBox[{"Show", "[", RowBox[{"k1", ",", \(ViewPoint \[Rule] {0, 0, 999}\), ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", RowBox[{\(k22[\([2, 2]\)]\), "=", RowBox[{"Show", "[", RowBox[{"k1", ",", StyleBox["DI", ShowStringCharacters->True, NumberMarks->True]}], "]"}]}], ";", StyleBox[\($DisplayFunction\ = \ Display[$Display, \ #1]\ &\), ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["GraphicsArray", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], "k22", "]"}]}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Abbreviations X", StyleBox["xyz, AA,AF,DI,BF,LF.", FontSlant->"Italic"] }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{\( (*Plot\ Option\ Abbreviations*) \), "\[IndentingNewLine]", RowBox[{ RowBox[{ StyleBox["V900", FontColor->RGBColor[0, 1, 0]], "=", \(ViewPoint -> {9, 0, 0}\)}], ";", RowBox[{ StyleBox["V090", FontColor->RGBColor[0, 1, 0]], "=", \(ViewPoint -> {0, 9, 0}\)}], ";", RowBox[{ StyleBox["V291", FontColor->RGBColor[0, 1, 0]], "=", \(ViewPoint -> {2, 9, 1}\)}], ";", RowBox[{ StyleBox["V009", FontColor->RGBColor[0, 1, 0]], "=", \(ViewPoint -> {0, 0, 9}\)}], ";", RowBox[{ StyleBox["V003", FontColor->RGBColor[0, 1, 0]], "=", \(ViewPoint -> {0, 0, 3}\)}], ";", RowBox[{ StyleBox["AF", FontColor->RGBColor[0, 1, 0]], "=", \(Axes \[Rule] False\)}], ";", RowBox[{ StyleBox["AA", FontColor->RGBColor[0, 1, 0]], "=", \(AspectRatio \[Rule] Automatic\)}], ";", RowBox[{ StyleBox["DI", FontColor->RGBColor[0, 1, 0]], "=", \(DisplayFunction -> Identity\)}], ";", RowBox[{ StyleBox["BF", FontColor->RGBColor[0, 1, 0]], "=", \(Boxed \[Rule] False\)}], ";", RowBox[{ StyleBox["LF", FontColor->RGBColor[0, 1, 0]], "=", \(Lighting \[Rule] False\)}], ";"}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.2.", StyleBox[" spaceCurve", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[TextData[{ "Procedure ", StyleBox["spaceCurve", FontSlant->"Italic"], "." }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{ StyleBox[\(\(20/3\)/5\), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["Calculates", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["cubic", FontColor->RGBColor[0, 0, 1]]}], StyleBox[",", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["interpolates", FontColor->RGBColor[0, 0, 1]], StyleBox[",", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(and\ calls\ either\ curvshow\ or\ tubeshow . \ t = j/d . \ twist\), FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], "\n", RowBox[{ RowBox[{ StyleBox["spacecurve", FontColor->RGBColor[0, 1, 0]], "[", \(f_, r_, chono_, sh_, p1_, te_, twi_\), "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({a, a0 = {0}, ai, b, c = {}, curvlen = 0, cof = {}, d, dl = 1, dr = Length[f], dt, f0 = f, fl, f1, f2, ls = Length[f[\([1, 1]\)]], seglen, s, s2, s4, s5, slopes = {}, slt = {{}}, t, tw = twi, u = {}, uo, uu = 1}\), ",", " ", RowBox[{\(smax = 0. \), ";", StyleBox[\(If[pr > 8, Print[{"\", f}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], StyleBox[\( (*For\ each\ line, \ add/remove\ end\ points\ for\ threads/\(\(loops\)\(.\)\)*) \ \), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{ StyleBox["f0", ShowStringCharacters->True, NumberMarks->True], StyleBox["=", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["If", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox[\(\((f1 = f0[\([1]\)])\) == \((f2 = f0[\([\(-1\)]\)])\)\), ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(\(dr--\); Most[f0]\), ShowStringCharacters->True, NumberMarks->True], StyleBox[\( (*\ Loop\ closure\ removed\ *) \), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], StyleBox["\[IndentingNewLine]", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(\(dl++\); Insert[Insert[f0, 2 f1 - f0[\([2]\)], 1], 2 f2 - f0[\([\(-2\)]\)], \(-1\)]\), ShowStringCharacters->True, NumberMarks->True]}], StyleBox[\( (*Open\ Thread\ extended*) \), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(If[pr > 8, Print[{"\", f0, dl, dr, te}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*\ Interpolation\ parameters, \ with\ wraparound\ *) \), FontColor->RGBColor[0, 0, 1]], "\n", " ", \(fl = RotateLeft[f0]\), ";", \(s = .8 \((fl - RotateRight[f0])\)/te\), ";", "\n", \(uo = fl - f0\), ";", \(s2 = RotateLeft[s]\), ";", \(a = 3\ uo - 2 s - s2\), ";", \(b = \(-2\) uo + s + s2\), ";", "\n", StyleBox[\( (*Find\ segment\ lengths\ and\ subdivisions\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(seglen = N[Plus @@ Transpose\ [\@\(4\ a\^2/3 + 3\ a\ b + 9\ b\^2/5 + 2\ \((a \ + b)\)\ s + s\^2\)]]\), ";", StyleBox[\( (*Find\ segment\ starting\ angles\ if\ \ \(\(twisted\)\(.\)\)\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"If", "[", RowBox[{\(tw \[NotEqual] 0 && tw \[Element] Rationals\), ",", RowBox[{\(curvlen = Plus @@ seglen\), ";", StyleBox[\( (*Total\ twists\ *) \), FontColor->RGBColor[0, 0, 1]], \(tw = 2 \[Pi]\ tw/curvlen\)}]}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\( (*Create\ chords\ *) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(dt = IntegerPart[seglen\ chono + 1]\), ";", \(smax = Max[smax, seglen]\), ";", \(uu = 1\), ";", "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[{"\", seglen, dt, curvlen}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{"Do", "[", RowBox[{ RowBox[{\(d = dt[\([i]\)]\), ";", \(If[IntegerQ[chono], d = chono]\), ";", RowBox[{"If", "[", RowBox[{\(d == 0\), ",", StyleBox[\( (*ignore\ lengths\ of\ zero*) \), FontColor->RGBColor[0, 0, 1]], ",", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{\(ds = seglen[\([i]\)]/d\), ";", \(ai = a0[\([\(-1\)]\)]\), ";", \(AppendTo[u, uu]\), ";", "\n", " ", RowBox[{"Do", "[", RowBox[{ RowBox[{\(t = j/d\), ";", \(AppendTo[cof, Chop[N[\((f0\[LeftDoubleBracket] i\[RightDoubleBracket] + t \((s[\([i]\)] + t \((a[\([i]\)] + t*b[\([i]\)])\))\))\)]]]\), ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{\(r \[NotEqual] 0\), ",", StyleBox[\( (*heights*) \), FontColor->RGBColor[0, 0, 1]], " ", \(AppendTo[slopes, Chop[N[\((s[\([i]\)] + t \((2 a[\([i]\)] + 3 t*b[\([i]\)])\))\) ds]]]\)}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\( (*Create\ starting\ angles\ *) \), FontColor->RGBColor[0, 0, 1]], RowBox[{"If", "[", RowBox[{\(tw \[NotEqual] 0\), ",", StyleBox[\( (*twist*) \), FontColor->RGBColor[0, 0, 1]], " ", RowBox[{\(AppendTo[a0, Mod[a0[\([\(-1\)]\)] + tw\ ds, 2 \[Pi]]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", a0, ai, tw, ds}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]]}]}], "]"}], ";", "\[IndentingNewLine]", \(uu++\)}], ",", "\[IndentingNewLine]", \({j, 1, d}\)}], "]"}]}]}], "]"}]}], ",", "\[IndentingNewLine]", \({i, dl, dr}\)}], "]"}], ";", "\[IndentingNewLine]", \(PrependTo[cof, cof[\([\(-1\)]\)]]\), ";", \(If[r \[NotEqual] 0, PrependTo[slopes, slopes[\([\(-1\)]\)]]]\), ";", "\[IndentingNewLine]", \(If[tw \[Equal] 0, a0 = Table[0, {Length[cof]}]]\), ";", "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[{"\", dr, dl, dr - dl, Length[f0], "\", a0}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 1]], StyleBox[\(If[dl == 2, cof = Rest[cof]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], "\n", \(xyz = AppendTo[xyz, cof]\), RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{ RowBox[{ StyleBox["for", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["crossings", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]]}], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["&", FontColor->RGBColor[0, 0, 1]]}], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["depthshow", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]]}], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], ";", "\n", RowBox[{"If", "[", RowBox[{\(r > 0\), ",", RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", cof, "\", slopes, dl, r, p1, a0}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\(tubeshow[cof, slopes, dl, r, p1, a0]\), FontColor->RGBColor[0, 1, 0]]}], ",", "\n", " ", RowBox[{\(If[ Length[sh] > 2, \(uo = Sign[\(Transpose[ f0]\)[\([sh[\([3]\)]]\)]];\)\ \[IndentingNewLine], uo = Table[0, {i, Length[f0]}]]\), ";", "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[{"\", f0, Short[cof], sh, "\<=sh, uo,u=\>", uo, u}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[" ", FontColor->RGBColor[0, 1, 0]], StyleBox[\(curvshow[f0, cof, sh, uo, u]\), FontColor->RGBColor[0, 1, 0]], "\[IndentingNewLine]", ";"}]}], "]"}]}]}], "]"}]}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.3.", StyleBox[" tubeshow, makePolygons.", FontSlant->"Italic"] }], "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[TextData[{ "3.3.1. Procedures ", StyleBox["tubeshow, makePolygons", FontSlant->"Italic"], "." }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ \(\(Clear[tubeshow, v, w];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["MakePolygons", FontColor->RGBColor[0, 1, 0]], "[", "vl_List", "]"}], ":=", \(Block[{l = vl, l1 = RotateLeft /@ vl, numesh}, numesh = {l, RotateLeft[l], RotateLeft[l1], l1}; numesh = Map[Drop[#1, \(-1\)] &, numesh, {1}]; numesh = Map[Drop[#1, \(-1\)] &, numesh, {2}]; Polygon /@ Transpose[\((Flatten[#1, 1] &)\) /@ numesh]]\)}]], "Input",\ PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ RowBox[{ StyleBox[\( (*\ \(20/3\)/5\ with\ twist*) \), ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["Normalize", FontColor->RGBColor[0, 1, 0]], "[", "v_", "]"}], ":=", \(v/Sqrt[v . v]\)}], ";", RowBox[{ RowBox[{"Options", "[", StyleBox["tubeshow", FontColor->RGBColor[0, 1, 0]], "]"}], "=", \({tubeFraming \[Rule] Normal, tubeshowPrelude \[Rule] {}}\)}], ";", RowBox[{ RowBox[{ StyleBox["tubeshow", FontColor->RGBColor[0, 1, 0]], "[", \(cof_, sl_, dl_, r_, p1_, a0_\), "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({npoints, gvec = N[{1.0, 1.0, 1.0}/\@3], framing, prelude, (*vpoints, xpoints, scpoints, *) tmesh}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"npoints", "=", RowBox[{ StyleBox["Normalize", FontColor->RGBColor[0, 1, 0]], "/@", "sl"}]}], ";", RowBox[{"vpoints", "=", RowBox[{ StyleBox["Normalize", FontColor->RGBColor[0, 1, 0]], "/@", \(\((gvec -= gvec . #1\ #1 &)\) /@ npoints\)}]}], ";", RowBox[{"xpoints", "=", RowBox[{ StyleBox["Normalize", FontColor->RGBColor[0, 1, 0]], "/@", \(\((Cross @@ #1 &)\) /@ Transpose[{npoints, vpoints}]\)}]}], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{"scpoints", "=", StyleBox[\( (*Starting\ angles\ for\ twists*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(Table[ N[{Cos[t + a0[\([i]\)]], Sin[t + a0[\([i]\)]]}\ r], {i, 1, Length[cof]}, {t, 0, 2\ \[Pi], 2\ \[Pi]/p1}]\)}], ";", \(tmesh = Table[cof\[LeftDoubleBracket]i\[RightDoubleBracket] + scpoints[\([i, j]\)] . {vpoints\[LeftDoubleBracket]i\ \[RightDoubleBracket], xpoints\[LeftDoubleBracket]i\[RightDoubleBracket]}, \ {j, 1, p1 + 1}, {i, dl, Length[cof]}]\), ";", RowBox[{"AppendTo", "[", RowBox[{"gcurv", ",", RowBox[{"Show", "[", RowBox[{"Graphics3D", "[", RowBox[{ RowBox[{ StyleBox["MakePolygons", FontColor->RGBColor[0, 1, 0]], "[", "tmesh", "]"}], ",", StyleBox[\(FilterOptions[Graphics3D, localopts, opts]\), FontColor->RGBColor[0, 1, 1]]}], "]"}], "]"}]}], "]"}]}]}], "]"}]}], ";"}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.4.", StyleBox[" curvshow, pointer, depthshow", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[TextData[{ "3.4.1. Procedures ", StyleBox["curvshow, pointer", FontSlant->"Italic"], "." }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ \(\(Clear[pointer, curvshow];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["pointer", FontColor->RGBColor[0, 1, 0]], "[", \(cof2_, uo_, u_\), "]"}], ":=", \(Module[{p = {}, ui, l = Length[u], xy}, Do[ui = uo[\([i]\)]; xy = cof2[\([u[\([i]\)]]\)]; PrependTo[ p, {Text[ToString[i], xy + {\(-siz\)/32, siz\ ui/48}], PointSize[ .02], Point[xy]}], {i, l}]; p]\)}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["curvshow", FontColor->RGBColor[0, 1, 0]], "[", \(h_, cof_, sh_, uo_, u_\), "]"}], ":=", StyleBox[\( (*\(+Hue\), \ \(19/6\)/5*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{\({c = Transpose[cof], cof2, cof3 = {}, ls = Length[sh], o}\), ",", RowBox[{\(cof2 = Transpose[Take[c, 2]]\), ";", \(siz = Flatten[cof2]\), ";", \(siz = Max[siz] - Min[siz]\), ";", \(If[ls > 2, cof3 = \(Take[c, {3}]\)[\([1]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", Short[cof2], Short[cof3], "\", ls, "\< sh =\>", sh}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Plot\ against\ T, \ or\ as\ 2 D\ or\ 3 D\ \(\(curve\)\(.\)\)*) \), FontColor->RGBColor[0, 0, 1]], "\n", "\t", RowBox[{"Which", "[", RowBox[{\(sh \[Equal] {0}\), ",", StyleBox[\( (*ListPlot\ all\ coords*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(Do[ AppendTo[gcurv, ListPlot[c[\([ii]\)], PlotJoined -> True, PlotStyle -> Hue[ .29 ii]]], \[IndentingNewLine]{ii, Length[c]}]\), ",", "\[IndentingNewLine]", \(ls \[Equal] 1\), ",", StyleBox[\( (*ListPlot\ one\ coordinate*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(AppendTo[gcurv, ListPlot[c[\([sh[\([1]\)]]\)], PlotJoined -> True]]\), ",", "\n", "\t", \(ls > 2\), ",", StyleBox[\( (*2 D\ LinePlot\ with\ chord\ numbers, \ depth*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{"AppendTo", "[", RowBox[{"pts", ",", RowBox[{ StyleBox["Show", FontColor->RGBColor[0, 1, 0]], "[", RowBox[{"Graphics", "[", RowBox[{ RowBox[{ StyleBox["pointer", FontColor->RGBColor[0, 1, 0]], "[", \(cof2, uo, u\), "]"}], ",", "AF", ",", "AA"}], "]"}], "]"}]}], "]"}], ";", " ", RowBox[{"AppendTo", "[", RowBox[{"gcurv", ",", RowBox[{ StyleBox["Show", FontColor->RGBColor[0, 1, 0]], "[", \(Graphics\ [ ListPlot\ [cof2, PlotJoined -> True, PlotStyle \[Rule] {Thickness[ .005], Hue[Mod[Length[gcurv], 6]/6]}], AF, AA]\), "]"}]}], "]"}]}], ",", "\[IndentingNewLine]", \(ls == 2\), ",", StyleBox[\( (*2 D\ LinePlot\ with\ chord\ numbers*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{"AppendTo", "[", RowBox[{"pts", ",", RowBox[{ StyleBox["Show", FontColor->RGBColor[0, 1, 0]], "[", RowBox[{"Graphics", "[", RowBox[{ RowBox[{ StyleBox["pointer", FontColor->RGBColor[0, 1, 0]], "[", \(cof2, uo, u\), "]"}], ",", "AF", ",", "AA"}], "]"}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", " ", RowBox[{"AppendTo", "[", RowBox[{"gcurv", ",", RowBox[{ StyleBox["Show", FontColor->RGBColor[0, 1, 0]], "[", RowBox[{"Graphics", " ", "[", RowBox[{"ListPlot", " ", "[", RowBox[{ "cof2", ",", \(PlotJoined -> True\), ",", \(PlotStyle \[Rule] {Thickness[ .005], Hue[Mod[Length[gcurv], 6]/6]}\), ",", StyleBox[\(FilterOptions[Graphics2D, localopts, opts]\), FontColor->RGBColor[0, 1, 1]], StyleBox[",", FontColor->RGBColor[0, 1, 1]], "AF", ",", "AA"}], "]"}], "]"}], "]"}]}], "]"}]}], ",", "\[IndentingNewLine]", "_", ",", StyleBox[\(Print\ [{"\", ls, rad}\ ]\), FontColor->RGBColor[1, 0, 1]]}], "]"}], ";"}]}], "\[IndentingNewLine]", "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.4.2. Procedures ", StyleBox["lineEnds,", FontSlant->"Italic"], StyleBox[" depthshow", FontSlant->"Italic"], "." }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ \(Clear[depthshow, lineEnds]; xyz =. ;\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["lineEnds", FontColor->RGBColor[0, 1, 0]], "[", "lin_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({l = Table[Length[lin[\([i]\)]], {i, Length[lin]}]}\), ",", RowBox[{\(PrependTo[l, 0]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], \(Do[ l[\([i]\)] += l[\([i - 1]\)], {i, 2, Length[l]}]\), ";", "l"}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["depthshow", FontColor->RGBColor[0, 1, 0]], "[", \(xyz_: xyz\), "]"}], ":=", StyleBox[\( (*\(15/4\)/5\ using\ lineEnds*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{\(lin\ = {}\), ",", RowBox[{"linkends", "=", RowBox[{ StyleBox["lineEnds", FontColor->RGBColor[0, 1, 0]], "[", "xyz", "]"}]}], ",", \(xy = Transpose[Take[Transpose[Flatten[xyz, 1]], 2]]\), ",", \(z = \(Transpose[Flatten[xyz, 1]]\)[\([3]\)]\), ",", "zmin", ",", "zr"}], "}"}], ",", RowBox[{\(z = \((z + RotateLeft[z])\)/2\), ";", \(zmin = Min[z]\), ";", \(zr = Max[z]\), ";", \(zr = zr - zmin\), ";", \(If[zr \[Equal] 0, zr = 1; zmin = zmin - 1]\), ";", StyleBox[\(If[pr > 8, Print[{"\", z, xyz // tf, zmin, zr}]]\), FontColor->RGBColor[1, 0, 0]], ";", \(Do[ If\ [\(! MemberQ[linkends, i]\), AppendTo[ lin\ , {Thickness[\(\((z[\([i]\)] - zmin)\)/50\)/zr], Line[{xy[\([i]\)], xy[\([i + 1]\)]}]}]], {i, Length[xy] - 1}]\), ";", StyleBox[\(If[pr > 8, Print[lin\ ]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(Graphics[lin\ ]\)}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.5.", StyleBox[" ", FontSlant->"Italic"], "Circular knots and links, ", StyleBox["kn", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth], Cell["\<\ This generates the symmetrical n/2n-crossings knot/links with n odd/even. The \ radial displacement is dr (with |dr|<1 ); negating dr reverses the \ orientation. dz is the cyclic z displacement. If n is even, the second loop \ is displaced by dx. This allows the knopf link to be generated by \ kn[2,1,-.15,1]\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["kn", FontColor->RGBColor[0, 1, 0]], "[", \(n_, dz_: 1/4, dr_: 1/4, dx_: 0\), "]"}], ":=", StyleBox[\( (*\(9/4\)/5\ N\ *) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({sr1 = If[dr == 0, 2, 2 Sign[dr]], sr2 = If[dr == 0, \(-2\), 2 Sign[dr]]}\), ",", RowBox[{ StyleBox[\(If[ n \[LessSlantEqual] 1 || \((dr == 0 && Abs[dx] < .5)\), Print\ [{"\", n, "\< dr=\>", dr}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], "\[IndentingNewLine]", StyleBox[ RowBox[{" ", StyleBox[" ", FontColor->RGBColor[0, 0, 1]]}]], StyleBox[\( (*\ Generates\ the\ circular\ knot\ \((n\ odd, \ \(\(>\)\(1\)\))\)\ or\ link\ \((n\ even, \ 2 nd\ link\ displaced\ by\ dz)\)\ with\ n\ \ \(\(crossings\)\(.\)\)\ *) \), FontColor->RGBColor[0, 0, 1]], "\n", RowBox[{"If", "[", RowBox[{\(OddQ[n]\), ",", \({N[ Table[{\((dr*Cos[\((i*Pi)\)/2] + 1)\)*Cos[\((i*Pi)\)/n] sr1, \((dr*Cos[\((i*Pi)\)/2] + 1)\)* Sin[\((i*Pi)\)/n] sr1, dz*Sin[\((i*Pi)\)/2]}, {i, 4*n, 0, \(-1\)}]]}\), ",", "\[IndentingNewLine]", StyleBox[\( (*Even*) \), FontColor->RGBColor[0, 0, 1]], \({N[ Table[{\((dr*Cos[i*Pi] + 1)\)* Cos[\((i*Pi)\)/n]\ sr1, \((dr*Cos[i*Pi] + 1)\)* Sin[\((i*Pi)\)/n] sr1, dz*Sin[\((2*i*Pi)\)/2]}, \[IndentingNewLine]{i, 0, 2*n, 1/2}]], N[Table[{dx + Cos[\((i*Pi)\)/n]*\((dr*Cos[\((i + 1)\)*Pi] + 1)\) sr2, \((dr*Cos[\((i + 1)\)*Pi] + 1)\)* Sin[\((i*Pi)\)/n] sr2, dz*Sin[\((1/2)\)*\((2*i - 2)\)* Pi]}, \[IndentingNewLine]{i, 0, 2*n (*\(-1\)/2*) , 1/2}]]}\)}], "]"}]}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.6.", StyleBox[" ", FontSlant->"Italic"], "Braids, ", StyleBox["braid, ringBraid, loopBraid, reducedBraidList", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["3.6.1. Introduction to Braids.", "Subsubsection"], Cell[TextData[{ "\tAlexander's theorem says that all knots and links can be shown as \ \"closed braids\", though the braid may need more crossings than the minimum \ for the knot. Braids ", Cell[BoxData[ \(TraditionalForm\`B\_n\)]], " are ", StyleBox["n", FontSlant->"Italic"], " threads between points on a pair of parallel lines, such that any \ intermediate parallel line intersects each thread once - the threads do not \ loop back. \n\tThey are often shown going down the page. This convention is \ used in [4] & [6]. In this notebook they go from left to right (as in [5]); \ illustrations then fit better on the page. Closed braids have the \ corresponding positions joined, end-to-end. They can be drawn in the form \ that I call \"ring braids\", with explicit continuation round a ring of \ several threads, or \"loop braids\" with the connections as lines below the \ braid. Knot analysis can be performed on these forms after using ", StyleBox["crosscurv", FontSlant->"Italic"], ".\n\tA \"braid word\" such as ", Cell[BoxData[ \(TraditionalForm\`\(\[Sigma]\_2\) \(\[Sigma]\_1\) \(\[Sigma]\_1\) \(\ \[Sigma]\_2\%\(-1\)\) \[Sigma]\_1\)]], Cell[BoxData[ \(TraditionalForm\`\[Sigma]\_1\)]], " [4, Ch5] describes a braid as a list of the braids that move up. I \ describe them as a ", StyleBox["braidlist", FontSlant->"Italic"], ", a list of the indices of the braid word, negated for the negative powers \ e.g. {2,1,1,-2,1,1}. This shows the sequence of braids that move up a \ position, negated if it makes an underpass. A \"normal form\" can be obtained \ by ", StyleBox["reducedBraidList", FontSlant->"Italic"], " simplification via Markov moves (an extension of Reidermeister knot moves \ to braids) and rotation to give the \"largest\" unsigned list, with the first \ entry positive. Negation corresponds to reversing the braid direction; the \ unsigned list is the knot shadow. This provides a compact (one signed integer \ per crossing) descriptor. There are severe restrictions on the ", StyleBox["reducedbraidlist", FontSlant->"Italic"], " if it is to describe a simple knot; this may be relevant to knot \ tabulation. The current procedure does not give a knot invariant; I \ hypothesize that an improved procedure might do so.\n\t", StyleBox["reducedBraidList[braidlist]", FontSlant->"Italic"], " creates a simplified and normalized ", StyleBox["braidlist", FontSlant->"Italic"], " and \nlists the links as the strand indices.\n\t", StyleBox["braid[braidlist]", FontSlant->"Italic"], " creates a ", StyleBox["linelist", FontSlant->"Italic"], " that can be processed by ", StyleBox["curvs", FontSlant->"Italic"], " or ", StyleBox["crosscurv ", FontSlant->"Italic"], "as individual threads. ", StyleBox["ringBraid[braidlist]", FontSlant->"Italic"], " and ", StyleBox["loopBraid[braidlist]", FontSlant->"Italic"], " create a ", StyleBox["linelist", FontSlant->"Italic"], " of closed links.\n\t[6,p92] gives Alexander's procedure to find a braid \ for any knot diagram - Chose a braid axis through a region. Follow a strand \ in a chosen direction, throwing the strand over the axis whenever it reverses \ direction. This sounds simple, but many axes may need testing to find the \ minimal braid. This will have more crossings than the knot if the simplest \ knot diagram shows reversals. ", StyleBox["reducedBraidList", FontSlant->"Italic"], " can then be used to standardize the result." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.6.2. ", StyleBox["braid", FontSlant->"Italic"], ",", StyleBox["ringBraid,loopBraid, reducedBraidList.", FontSlant->"Italic"] }], "Subsubsection"], Cell[BoxData[ \(\(Clear[braid, ringBraid, loopBraid, \ reducedBraidList];\)\)], "Input",\ PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{\(braid[braidlist_List]\), ":=", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["converts", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["braidlist", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["to", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(\(braids\)\(.\)\), FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{\({e, j, jk, k, l = Length[braidlist], n = 3, oj = 0, ok = 0, p, pj, pk, pjk, pjok, res, s, w, x = 2}\), ",", RowBox[{ StyleBox[\(If[ MemberQ[braidlist, Null] || \(! NumericQ[Plus @@ braidlist]\), Print[{"\", braidlist}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(w = Max[Abs[braidlist]] + 1\), ";", \(p = Range[w]\), ";", StyleBox["\[IndentingNewLine]", FontSlant->"Plain"], \(res = Table[{{0, i, 0}, {1, i, 0}}, {i, w}]\), ";", "\[IndentingNewLine]", RowBox[{"Do", "[", StyleBox[\( (*i\ loop\ through\ braidlist*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(j = Abs[braidlist[\([i]\)]]\), ";", "\[IndentingNewLine]", \(pj = p[\([j]\)]\), ";", \(k = j + 1\), ";", \(pk = p[\([k]\)]\), ";", \(jk = N[\((j + k)\)/2]\), ";", RowBox[{"If", "[", RowBox[{\(Length[Union[pjok = {pj, pk, oj, ok}]] == 4 && Length[pjk] \[NotEqual] 4\), ",", StyleBox[\( (*disjoint\ crosses, \ back - track\ x, pj, pk*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{\(x--\), ";", \(res[\([pj]\)] = Most[res[\([pj]\)]]\), ";", \(res[\([pk]\)] = Most[res[\([pk]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", pj, pk}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(pjk = pjok\)}], ",", \(pjk = {pj, pk}\)}], "]"}], ";", \(s = Sign[braidlist[\([i]\)]]/2\), ";", StyleBox[\(If[pr > 8, Print[{j, k, pj, pk}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(AppendTo[ res[\([pj]\)], {x - .51, jk, s}]\), ";", \(AppendTo[res[\([pj]\)], {x, k, 0}]\), ";", \(AppendTo[res[\([pk]\)], {x - .49, jk, \(-s\)}]\), ";", \(AppendTo[res[\([pk]\)], {x, j, 0}]\), ";", \(p[\([j]\)] = pk\), ";", \(p[\([k]\)] = pj\), ";", StyleBox[\(If[pr > 8, Print[{"\", x, j, p, {x - .49, jk, s}, {x, k, s}, {x - .51, jk, \(-s\)}, {x, j, \(-s\)}}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{"Do", "[", RowBox[{ RowBox[{"If", "[", RowBox[{\(res[\([e, \(-1\), 1]\)] \[Equal] x\), ",", StyleBox[\( (*already\ crossed\ and\ extended*) \ \), FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr > 8, Print[{"\", e, pj, pk}]];\), FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Extend\ idle\ lines*) \), FontColor->RGBColor[0, 0, 1]], ",", RowBox[{ RowBox[{"AppendTo", "[", RowBox[{\(res[\([e]\)]\), ",", RowBox[{"{", RowBox[{ "x", ",", \(res[\([e, \(-1\), 2]\)]\), StyleBox[",", FontColor->GrayLevel[0]], StyleBox[\(res[\([e, \(-1\), 3]\)]\), FontColor->GrayLevel[0]]}], StyleBox["}", FontColor->GrayLevel[0]]}]}], "]"}], StyleBox[\(If[pr > 8, Print[{"\", e, pj, pk, {x, res[\([e, \(-1\), 2]\)], res[\([e, \(-1\), 3]\)]}}]]\), FontColor->RGBColor[1, 0, 0]]}]}], "]"}], ",", \({e, w}\)}], "]"}], ";", \(oj = pj\), ";", \(ok = pk\), ";", "\[IndentingNewLine]", \(x++\)}], ",", "\[IndentingNewLine]", \({i, l}\)}], "]"}], ";", \(Do[ AppendTo[ res[\([i]\)], {res[\([i, \(-1\), 1]\)] + 1, res[\([i, \(-1\), 2]\)], res[\([i, 1, 3]\)]}], {i, w}]\), ";", "res"}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["loopBraid", FontColor->RGBColor[0, 1, 0]], "[", "braidlist_", "]"}], ":=", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["converts", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["braidlist", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["to", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["loopbraid", FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{\(b = braid[braidlist]\), ",", "i", ",", "i2", ",", "l", ",", "ln", ",", \(n = {0, 1, 0}\), ",", \(res = {{}}\), ",", "todo", ",", \(w = Max[Abs[braidlist]] + 1\), StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\( (*width*) \), FontColor->RGBColor[0, 0, 1]], StyleBox[",", FontColor->RGBColor[0, 0, 1]], "x"}], "}"}], ",", RowBox[{ StyleBox[\(If[ MemberQ[braidlist, Null] || \(! NumericQ[Plus @@ braidlist]\), Print[{"\", braidlist}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(todo = Range[w]\), ";", \(ln = 1\), ";", \(l := {{x + i2 + .25, i2 - .5, 0}, {x + i2 - .2, 1 - i2, 0}, {3 x/4 + 1, .6 - \ .7 i, 0}, {x/4 + 1, .6 - .7\ i, 0}, {2.2 - i2, 1 - i2, 0}, {1.8 - i2, i2 - .5, 0}}\), ";", RowBox[{"Do", "[", RowBox[{ RowBox[{\(i = If[MemberQ[todo, n[\([2]\)]], n[\([2]\)], \(ln++\); AppendTo[res, {}]; Min[todo]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", n, ii, i, "\", todo, Min[todo]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(todo = Drop[todo, \(Position[todo, i]\)[\([1]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", n, i, todo, b[\([i, 2]\)]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(Do[ res[\([ln]\)] = {res[\([ln]\)], n = b[\([i, j]\)]}, {j, 2, Length[b[\([i]\)]] - 1}]\), ";", \(x = n[\([1]\)] - 1\), ";", \(i = n[\([2]\)]\), ";", \(i2 = \((1 + i)\)/2\), ";", StyleBox[\(If[pr > 8, Print[{"\", n, x, i}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", \(Do[ res[\([ln]\)] = {res[\([ln]\)], l[\([j]\)]}, {j, Length[l]}]\)}], ",", \({ii, w}\)}], "]"}], ";", "\[IndentingNewLine]", \(Do[ res[\([n]\)] = Partition[Flatten[res[\([n]\)]], 3]; AppendTo[res[\([n]\)], res[\([n, 1]\)]], {n, Length[res]}]\), ";", "res"}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(ringBraid[braidlist0_List]\), ":=", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["converts", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["braidlist", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["to", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["ringbraid", FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"braidlist", ",", RowBox[{"b", "=", RowBox[{ StyleBox["reducedBraidList", FontColor->RGBColor[0, 1, 0]], "[", "braidlist0", "]"}]}], ",", "j", ",", "jk", ",", "k", ",", "l", ",", "links", ",", \(n = 3\), ",", \(oj = 0\), ",", \(ok = 0\), ",", "p", ",", "pj", ",", "pjk", ",", "pk", ",", "pjok", ",", "r", ",", "res", ",", "res1", ",", "t", ",", "w", ",", \(x = 1\)}], "}"}], ",", "\[IndentingNewLine]", RowBox[{\(braidlist = b[\([1]\)]\), ";", \(l = Length[braidlist]\), ";", \(links = \(Transpose[b[\([2]\)]]\)[\([1]\)]\), ";", StyleBox[\(If[pr > 8, Print[{"\", braidlist, links}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\(If[ MemberQ[braidlist, Null] || \(! NumericQ[Plus @@ braidlist]\), Print[{"\", braidlist}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(w = Max[Abs[braidlist]] + 1\), ";", \(p = Range[w]\), ";", StyleBox["\[IndentingNewLine]", FontSlant->"Plain"], \(res = Table[{{0, i, 0}}, {i, w}]\), ";", "\[IndentingNewLine]", RowBox[{"Do", "[", StyleBox[\( (*i\ loop\ through\ braidlist*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(j = Abs[braidlist[\([i]\)]]\), ";", "\[IndentingNewLine]", \(pj = p[\([j]\)]\), ";", \(k = j + 1\), ";", \(pk = p[\([k]\)]\), ";", \(jk = N[\((j + k)\)/2]\), ";", RowBox[{"If", "[", RowBox[{\(Length[Union[pjok = {pj, pk, oj, ok}]] == 4 && Length[pjk] \[NotEqual] 4\), ",", StyleBox[\( (*disjoint\ crosses, \ back - track\ x, pj, pk*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{\(x--\), ";", \(res[\([pj]\)] = Most[res[\([pj]\)]]\), ";", \(res[\([pk]\)] = Most[res[\([pk]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", pj, pk}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(pjk = pjok\)}], ",", \(pjk = {pj, pk}\)}], "]"}], ";", \(s = Sign[braidlist[\([i]\)]]/2\), ";", StyleBox[\(If[pr > 8, Print[{j, k, pj, pk}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(AppendTo[ res[\([pj]\)], {x - .5, jk, s}]\), ";", \(AppendTo[res[\([pj]\)], {x, k, 0}]\), ";", \(AppendTo[res[\([pk]\)], {x - .5, jk, \(-s\)}]\), ";", \(AppendTo[res[\([pk]\)], {x, j, 0}]\), ";", \(p[\([j]\)] = pk\), ";", \(p[\([k]\)] = pj\), ";", StyleBox[\(If[pr > 8, Print[{"\", x, j, p, {x - .49, jk, s}, {x, k, s}, {x - .51, jk, \(-s\)}, {x, j, \(-s\)}}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{"Do", "[", StyleBox[\( (*e\ loop\ idle\ \(\(lines\)\(?\)\)*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{"If", "[", RowBox[{\(res[\([e, \(-1\), 1]\)] \[Equal] x\), ",", StyleBox[\( (*already\ crossed\ and\ extended*) \ \), FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr > 8, Print[{"\", e, pj, pk}]];\), FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Extend\ idle\ lines*) \), FontColor->RGBColor[0, 0, 1]], StyleBox[",", FontColor->GrayLevel[0]], RowBox[{"AppendTo", "[", RowBox[{\(res[\([e]\)]\), ",", RowBox[{"{", RowBox[{ "x", ",", \(res[\([e, \(-1\), 2]\)]\), StyleBox[",", FontColor->GrayLevel[0]], StyleBox[\(res[\([e, \(-1\), 3]\)]\), FontColor->GrayLevel[0]]}], StyleBox["}", FontColor->GrayLevel[0]]}]}], "]"}]}], "]"}], ",", \({e, w}\)}], "]"}], ";", "\[IndentingNewLine]", \(oj = pj\), ";", \(ok = pk\), ";", \(x++\)}], ",", \({i, l}\)}], "]"}], ";", StyleBox[\( (*Braids\ completed . \ Find\ perimlength*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(m = res[\([\(-1\), \(-1\), 1]\)]\), ";", "\[IndentingNewLine]", StyleBox[\( (*Join\ braid\ ends*) \), FontColor->RGBColor[0, 0, 1]], \(n = 0\), ";", \(temp = {}\), ";", \(res1 = {}\), ";", \(p = Range[w]\), ";", StyleBox[\(If[pr > 8, Print[{"\", res}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], RowBox[{"While", "[", RowBox[{ RowBox[{\(i = Min[p]\), ";", \(j = i\), ";", \(n++\), ";", StyleBox[\( (*Sequence\ the\ braids*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(If[MemberQ[links, i], temp = {}]\), StyleBox[\( (*new\ link*) \), FontColor->RGBColor[0, 0, 1]], ";", \(While[\(p = Drop[p, \(Position[p, i]\)[\([1]\)]]; temp = {temp, Most[res[\([i]\)]]}; i = res[\([i, \(-1\), 2]\)]; j \[NotEqual] i\)\(,\)]\), ";", \(temp = Partition[Flatten[temp], 3]\), ";", "\[IndentingNewLine]", \(AppendTo[temp, temp[\([1]\)]]\), StyleBox[\( (*Close\ Link*) \), FontColor->RGBColor[0, 0, 1]], ";", "\[IndentingNewLine]", \(AppendTo[res1, temp]\), ";", "\[IndentingNewLine]", \(Length[p] > 1\)}], ","}], "]"}], ";", StyleBox[\( (*Braids\ joined*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(res = {}\), ";", StyleBox[\( (*Convert\ to\ Radial\ Coords*) \), FontColor->RGBColor[0, 0, 1]], ";", StyleBox[\(If[pr > 8, Print[{"\", m, Length[res1], res1}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Do", "[", RowBox[{ RowBox[{\(AppendTo[res, {}]\), StyleBox[\( (*new\ link*) \), FontColor->RGBColor[0, 0, 1]], ";", \(Do[t = N[2 \[Pi]\ res1[\([i, j, 1]\)]/m]; r = res1[\([i, j, 2]\)] + 1; res[\([i]\)] = {res[\([i]\)], Chop[{r\ Sin[t], r\ Cos[t], res1[\([i, j, 3]\)]}]};\[IndentingNewLine], {j, Length[res1[\([i]\)]]}]\), ";", \(res[\([i]\)] = Partition[Flatten[res[\([i]\)]], 3]\)}], "\[IndentingNewLine]", ",", \({i, Length[res1]}\)}], "]"}], ";", "\[IndentingNewLine]", StyleBox[";", FontColor->RGBColor[0, 0, 1]], "res"}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["reducedBraidList", FontColor->RGBColor[0, 1, 0]], "[", "braidlist_List", "]"}], ":=", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{ StyleBox["converts", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["braidlist", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["to", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["reduced", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\((normal)\), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["form", FontColor->RGBColor[0, 0, 1]]}], StyleBox[",", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(reports\ number\ of\ links\), FontColor->RGBColor[0, 0, 1]], StyleBox[",", FontColor->RGBColor[0, 0, 1]], StyleBox[\(reduces\ non - trivial\ components\), FontColor->RGBColor[0, 0, 1]]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{\({r = braidlist, i, j = 0, l, lf, m, mx = 0, p, up, w = Max[Abs[braidlist]] + 1}\), ",", RowBox[{ StyleBox[\(If[ MemberQ[braidlist, Null] || \(! NumericQ[Plus @@ braidlist]\), Print[{"\", braidlist}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox[\(If[pr > 8, Print[{"\", r}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*repeat; \ report\ blanks, \ R1, \ R2, \ swap\ disjoint\ pairs*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"While", "[", RowBox[{\(j \[NotEqual] Length[r] && mx \[NotEqual] Length[r]\), ",", RowBox[{\(mx = Length[r]\), ";", \(j = Length[r]\), ";", RowBox[{"If", "[", RowBox[{\(\((l = Complement[Range[w - 1], Union[Abs[r]]])\) \[NotEqual] {}\), ",", StyleBox[\(Print[{"\", l, Union[Abs[r]]}]\), FontColor->RGBColor[1, 0, 0]]}], "]"}], ";", StyleBox[\(If[pr > 8, Print[{"\", r, j, w}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*R1\ removal*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{"If", "[", RowBox[{\(Length[l = Position[Abs[r], 1]] \[Equal] 1\), ",", RowBox[{\(w--\), ";", \(j--\), ";", StyleBox[\(If[pr > 0, Print["\", r, "\", l]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(r = Drop[r, l[\([1]\)]]\), ";", \(r = Table[\((Abs[r[\([i]\)]] - 1)\) Sign[r[\([i]\)]], {i, Length[r]}]\), ";", StyleBox[\(If[pr > 8, Print[{"\", r, j, w}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]]}]}], "]"}], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{"If", "[", RowBox[{\(Length[l = Position[Abs[r], w - 1]] \[Equal] 1\), ",", RowBox[{\(w--\), ";", \(j--\), ";", StyleBox[\(If[pr > 0, Print[{"\", w, "\", r, "\", l}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(r = Drop[r, l[\([1]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", r, j, w}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]]}]}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\( (*R2\ remove\ \[NotSubset] \ pairs*) \), FontColor->RGBColor[0, 0, 1]], \(l = j\), ";", RowBox[{"While", "[", RowBox[{\(j > 1\), ",", RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", j, r[\([j - 1]\)], r[\([j]\)], mx}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], RowBox[{"If", "[", RowBox[{\(r[\([j - 1]\)] \[Equal] \(-r[\([j]\)]\)\), ",", RowBox[{\(r = Drop[r, {j - 1, j}]\), ";", StyleBox[\(If[pr > 8, Print[{"\", j, l, r}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(l -= 2\), ";", \(j--\)}]}], "]"}], ";", \(j--\)}]}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\( (*Now\ swap\ disjoint\ pairs\ to\ maximize\ u*) \ \), FontColor->RGBColor[0, 0, 1]], \(j = Length[r]\), ";", "\[IndentingNewLine]", RowBox[{"While", "[", RowBox[{\(j > 2\), ",", RowBox[{ RowBox[{"If", "[", RowBox[{\(\((l = Abs[r[\([j]\)]])\) > \((m = Abs[r[\([j - 1]\)]])\) && Abs[l - m] > 1\), " ", ",", RowBox[{\(r = Insert[Drop[r, {j}], r[\([j]\)], {j - 1}]\), ";", StyleBox[\(If[pr > 8, Print[{"\", j, l, m, r}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]]}]}], "]"}], ";", \(j--\)}]}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\( (*\ Now\ rotate\ to\ maximize\ r*) \), FontColor->RGBColor[0, 0, 1]], \(m = Position[Abs[r], Max[Abs[r]]]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(r = \(Sort[ Table[RotateLeft[r, m[\([i, 1]\)] - 1], {i, Length[m]}], OrderedQ[{Abs[#1], Abs[#2]}] &]\)[\([\(-1\)]\)]\), ";", \(If[r[\([1]\)] < 0, r = \(-r\)]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr > 8, Print[{"\", r}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", \(j = 0\)}]}], "]"}], ";", StyleBox[\( (*End\ of\ mx\ repeat*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", StyleBox[\( (*create\ position\ list*) \), FontColor->RGBColor[0, 0, 1]], \(p = Table[i, {i, w}]\), ";", "\[IndentingNewLine]", RowBox[{"Do", "[", RowBox[{ RowBox[{\(up = p[\([\((k = Abs[r[\([j]\)]])\)]\)]\), ";", \(p[\([k]\)] = p[\([k + 1]\)]\), ";", \(p[\([k + 1]\)] = up\), ";", StyleBox[\(If[pr > 8, Print[{"\", k, p}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]]}], ",", \({j, Length[r]}\)}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\( (*Find\ No . \ of\ links*) \), FontColor->RGBColor[0, 0, 1]], \(l = {}\), ";", \(j = 0\), ";", "\[IndentingNewLine]", RowBox[{"While", "[", RowBox[{\(lf = Flatten[l]; \((lf = Complement[p, lf])\) \[NotEqual] {}\), ",", "\[IndentingNewLine]", RowBox[{\(j = Min[lf]\), ";", \(AppendTo[l, {j}]\), ";", \(m = p[\([j]\)]\), ";", RowBox[{"While", "[", RowBox[{\(m \[NotEqual] j\), ",", RowBox[{\(AppendTo[l[\([\(-1\)]\)], m]\), ";", "\[IndentingNewLine]", \(m = p[\([m]\)]\), ";", StyleBox[\(If[pr > 8, Print[{"\", j, m, l}]]\), FontColor->RGBColor[1, 0, 0]]}]}], "]"}]}]}], "\[IndentingNewLine]", "]"}], ";", StyleBox[\(If[pr > 0, Print[{"\", Length[l], l, "\<\nNo of nodes = \>", Length[r]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", ";", \({r, l}\)}]}], "]"}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.6.3. ", StyleBox["braidlist", FontSlant->"Italic"], " restrictions ", "to describe simple knots." }], "Subsubsection", PageWidth->PaperWidth], Cell[TextData[{ "\tFor a normalized ", StyleBox["braidlist", FontSlant->"Italic"], " to describe a simple knot it must meet strict requirements.\n\t\ Preliminary conjectures, for braids with b+1 strands and c crossings:-\n(1) 1 \ and b must both occur at least twice, with the same sign, in a link, and more \ in a knot, to avoid isolated loops or R1 simplification.\n(2) {n,-n} pairs \ can be eliminated (R2 move).\n(3) {n,m} pairs can be converted to {m,n} if \ |m|>|n| to maximize the sequence (R3 move).\n(3) Even c means an odd number \ of strands (even b) and vice-versa?? Many knots have more than c braid \ crossings in the simplest braid.\n(4) b=2 only provides torus knots {1,1 \ ....}.\n(5) No missing numbers are allowed as they disconnect the diagram \ into loops.\n(6) No \"singletons\" (numbers that appear only once) are \ allowed as they give composite knots." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["3.6.4. Generalizations.", "Subsubsection", PageWidth->PaperWidth], Cell["\<\ \tComposite knots are created by connecting simple-knot braids in series; \ later braids can be rotated, and can be inserted at different places in \ earlier braids; \"singletons\" connect the components together \tInstead of \"end to beginning\" closure, even-strand braids can be \"capped\ \" by semi-circles joining pairs of strands, provided that the pair have not \ just crossed and their last crossings are of opposite hand - otherwise some \ crossings are lost. Tricky, and standard theory is lost. \tBraids can be tubular, with some crossings between top and bottom strands. \ This could be shown by zeroes in the knot list. Not explored. \tAshley has many pages on single-strand lanyard and button knots, and more \ on multi-strand confections; many of these are capped braids. \ \>", "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.7.", StyleBox[" ", FontSlant->"Italic"], "Rotating Knots ", StyleBox["rxyz, rx4, rx3, etc., rxyz4, rxyz3", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth, InitializationCell->True], Cell["\<\ Matrices are provided to rotate 3 or 4D lines by angles {x,y,z} in the \ anticlockwise direction.\ \>", "Text", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(x =. ; y =. ; z =. ; Clear[ryz, rx3, rx4, ry3, ry4, rz3, rz4, rxyz3];\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["ryz", FontColor->RGBColor[0, 1, 0]], "[", \(y_, z_\), "]"}], ":=", \({{Cos[z] Cos[y], Sin[z], \(-Cos[z]\) Sin[y]}, {\(-Sin[z]\) Cos[y], Cos[z], Sin[z] Sin[y]}, {Sin[y], 0, Cos[y]}}\)}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["rx4", FontColor->RGBColor[0, 1, 0]], "(", "x_", ")"}], ":=", RowBox[{"(", GridBox[{ {"1", "0", "0", "0"}, {"0", \(cos(x)\), \(-\(sin(x)\)\), "0"}, {"0", \(sin(x)\), \(cos(x)\), "0"}, {"0", "0", "0", "1"} }], ")"}]}], TraditionalForm]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["rx3", FontColor->RGBColor[0, 1, 0]], "(", "x_", ")"}], ":=", RowBox[{"(", GridBox[{ {"1", "0", "0"}, {"0", \(cos(x)\), \(-\(sin(x)\)\)}, {"0", \(sin(x)\), \(cos(x)\)} }], ")"}]}], TraditionalForm]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["ry4", FontColor->RGBColor[0, 1, 0]], "(", "y_", ")"}], ":=", RowBox[{"(", GridBox[{ {\(cos(y)\), "0", \(-\(sin(y)\)\), "0"}, {"0", "1", "0", "0"}, {\(-\(sin(y)\)\), "0", \(cos(y)\), "0"}, {"0", "0", "0", "1"} }], ")"}]}], TraditionalForm]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["ry3", FontColor->RGBColor[0, 1, 0]], "(", "y_", ")"}], ":=", RowBox[{"(", GridBox[{ {\(cos(y)\), "0", \(-\(sin(y)\)\)}, {"0", "1", "0"}, {\(-\(sin(y)\)\), "0", \(cos(y)\)} }], ")"}]}], TraditionalForm]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["rz4", FontColor->RGBColor[0, 1, 0]], "(", "z_", ")"}], ":=", RowBox[{"(", GridBox[{ {\(cos(z)\), \(-\(sin(z)\)\), "0", "0"}, {\(sin(z)\), \(cos(z)\), "0", "0"}, {"0", "0", "1", "0"}, {"0", "0", "0", "1"} }], ")"}]}], TraditionalForm]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["rz3", FontColor->RGBColor[0, 1, 0]], "(", "z_", ")"}], ":=", RowBox[{"(", GridBox[{ {\(cos(z)\), \(-\(sin(z)\)\), "0"}, {\(sin(z)\), \(cos(z)\), "0"}, {"0", "0", "1"} }], ")"}]}], TraditionalForm]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["rxyz3", FontColor->RGBColor[0, 1, 0]], "[", \(l_, x_, y_, z_\), "]"}], ":=", RowBox[{"Table", "[", RowBox[{ RowBox[{\(l[\([i]\)]\), ".", RowBox[{ StyleBox["rx3", FontColor->RGBColor[0, 1, 0]], "[", "x", "]"}], ".", RowBox[{ StyleBox["ry3", FontColor->RGBColor[0, 1, 0]], "[", "y", "]"}], ".", RowBox[{ StyleBox["rz3", FontColor->RGBColor[0, 1, 0]], "[", "z", "]"}]}], ",", \({i, Length[l]}\)}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["rxyz4", FontColor->RGBColor[0, 1, 0]], "[", \(l_, x_, y_, z_\), "]"}], ":=", RowBox[{"Table", "[", RowBox[{ RowBox[{\(l[\([i]\)]\), ".", RowBox[{ StyleBox["rx4", FontColor->RGBColor[0, 1, 0]], "[", "x", "]"}], ".", RowBox[{ StyleBox["ry4", FontColor->RGBColor[0, 1, 0]], "[", "y", "]"}], ".", RowBox[{ StyleBox["rz4", FontColor->RGBColor[0, 1, 0]], "[", "z", "]"}]}], ",", \({i, Length[l]}\)}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.8.", StyleBox[" ", FontSlant->"Italic"], "Conway notation, ", StyleBox["kConway, pf3, ", FontSlant->"Italic"], "Pretzel Knots ", StyleBox["kpretzel", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth, InitializationCell->True], Cell[TextData[{ "See Section 2.13 for a discussion of Conway's notation, tangles, and \ continued fractions. ", StyleBox["kConway", FontSlant->"Italic"], " works on a case-by-case basis, but only handles data as strings of up to \ 3 integers, e.g.\"332\". ", StyleBox["kpretzel ", FontSlant->"Italic"], "handles data in the form {i,j,..}." }], "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[TextData[StyleBox["ConwayUnpack, kConway.", FontSlant->"Italic"]], "Subsubsection", PageWidth->PaperWidth], Cell[TextData[{ "kConway", StyleBox[" uses ", FontSlant->"Plain"], "ConwayUnpack", StyleBox[" ", FontSlant->"Italic"], StyleBox["to create a list that can be plotted as a knot or link. \ Four-element and 6* (etc) Conway notation not implemented.", FontSlant->"Plain"] }], "Text", PageWidth->PaperWidth, FontSlant->"Italic"], Cell[BoxData[ \(\(Clear[ConwayUnpack, kConway, kpretzel];\)\)], "Input"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["ConwayUnpack", FontColor->RGBColor[0, 1, 0]], "[", \(c_String, f_: False\), "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({a = {}, aa}\), ",", RowBox[{ StyleBox[\(If[pr > 1, Print[{"\", c}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], RowBox[{"Do", "[", RowBox[{ RowBox[{\(aa = StringTake[c, {i}]\), ";", RowBox[{ StyleBox[ RowBox[{"(", StyleBox["*", FontColor->RGBColor[0, 0, 1]]}]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\(Unpack\ Conway - notation\), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Which", "[", RowBox[{\(aa == "\<,\>"\), ",", \(AppendTo[a, 0]\), ",", "\[IndentingNewLine]", \(aa == "\<-\>"\), ",", RowBox[{ StyleBox[\(If[i == 1, Print\ [{"\"}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], ";", \(a[\([\(-1\)]\)] *= \(-1\)\)}], ",", "\[IndentingNewLine]", \(aa == "\<+\>"\), ",", \(AppendTo[a, 1]\), ",", "\[IndentingNewLine]", \((aa == "\<*\>" || aa == "\<.\>")\), ",", \(Print[{c, "\< Not implemented\>"}]; Abort[]\), ",", "\[IndentingNewLine]", \(IntegerQ[ ae = ToExpression[aa]]\), ",", \(AppendTo[a, ae]\), ",", "\[IndentingNewLine]", "True", ",", \(Print[{c, "\< Not implemented\>"}; Abort[]]\)}], "]"}]}], ",", "\[IndentingNewLine]", \({i, StringLength[c]}\)}], "]"}], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\(If[IntegerQ[Plus @@ a], , Print\ ["\", a]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 1]], StyleBox[\(If[l == 1, Print\ [{"\", a, "\<]\>"}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(If[f, Print[{a, "\", FromContinuedFraction[Reverse[a]]}]]\), ";", "a"}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[{\(pf3[a_] := Partition[Flatten[a], 3];\), "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["kConway", FontColor->RGBColor[0, 1, 0]], "[", \(c_String, f_: False\), "]"}], ":=", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\( (*\ Generates\ a\ 1*\ Conway - notation\ knot . \ Unfinished, \ not\ handling\ 4\ or\ more\ \(\(integers\)\(.\)\)\ *) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({a, aa, ae, apm, as = 1, d = {0, 1, 0, \(-1\)}, dx, dy, dz, evnod, ht = 1, hv, l, lnk1 = {}, lnk2 = {}, mx = 0, my = 0, res = {}, temp1 = {}, temp2 = {}, tl, tr, bl, br, x = 1, xold = 1, y = 2, yold = 2, xl = 1, yl = 2, xt = 3, yt = 3, xb = 1, yb = 1}\), ",", "\[IndentingNewLine]", RowBox[{\(apm = ConwayUnpack[c, f]\), ";", \(a = Abs[apm]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], \(l = Length[a]\), ";", \(hv = 1 - 2 Mod[l, 2]\), ";", "\[IndentingNewLine]", \(evnod = Table[Mod[a[\([i]\)], 2], {i, l}]\), ";", StyleBox[\(If[pr > 8, Print[{"\", apm, l, hv, evnod}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox[\( (*ends\ start\ horizontal*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Do", "[", StyleBox[\( (*j . \ loop\ through\ links*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(hv *= \(-1\)\), StyleBox[\( (*switch\ horizontal/\(\(vertical\)\(.\)\)*) \ \), FontColor->RGBColor[0, 0, 1]], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], \(v = Max[\(-\ hv\), 0]\), ";", \(h = Max[\ hv, 0]\), ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{\(\((aa = a[\([j]\)])\) == 0\), StyleBox[\( (*\ Displace\ if\ aa == 0\ *) \), FontColor->RGBColor[0, 0, 1]], ",", RowBox[{"If", "[", RowBox[{\(v == 1\), ",", \(x = xold; y = my + 2; yold = y\), ",", "\[IndentingNewLine]", StyleBox[\( (*h = 1*) \), FontColor->RGBColor[0, 0, 1]], \(y = yold; x = mx + 2; xold = x\)}], "]"}], ",", RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", h, v, x, y, xold, yold}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox[\( (*\ Extend\ if\ aa \[NotEqual] 0\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(ae = If[EvenQ[aa], 1, \(-1\)]\), ";", \(as = Sign[apm[\([j]\)]]\), ";", \(temp1 = {}\), ";", \(temp2 = {}\), ";", "\[IndentingNewLine]", RowBox[{"Do", "[", RowBox[{ RowBox[{\(dx = d[\([Mod1[i, 4]]\)]\), ";", " ", StyleBox[\( (*v\ sideways\ displacement*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(dy = d[\([Mod1[i + 2, 4]]\)]\), ";", StyleBox[\( (*h\ sideways\ displacement*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(dz = d[\([Mod1[i + 1, 4]]\)]\), ";", StyleBox[\( (*z\ displacement*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(temp1 = {temp1, {x + i\ h + v\ dx, y + i\ v - h\ \ dy, as\ dz}}\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(temp2 = {temp2, {x + i\ h - v\ dx, y + i\ v + h\ \ dy, \(-as\)\ dz}}\), ";", "\[IndentingNewLine]", \(mx = Max[x + i\ h + 1, mx]\), ";", \(my = Max[y + i\ v + 1, my]\)}], "\[IndentingNewLine]", ",", \({i, 0, 2 aa}\)}], "]"}], ";", StyleBox[\( (*end\ \(\(Do\)\([\)\(dx\)\)*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(AppendTo[res, pf3[temp1]]\), ";", \(AppendTo[res, pf3[temp2]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", lnk1, lnk2}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{\(h == 1\), ",", \(xt = mx; yr = my; yb = my - 2; x = Floor[\((xl + xt)\)/2]; y = Max[yl, yt] + 1\), ",", "\[IndentingNewLine]", " ", StyleBox[\( (*v == 1*) \), FontColor->RGBColor[0, 0, 1]], \(xt = mx; xl = mx - 2; yt = my; yl = my; xold = x; x = Max[xb, xt] + 1; yold = y; y = Floor[\((yt + yb)\)/2]\)}], "]"}], StyleBox[\( (*\(endIf\)\([\)\(h == 1\)*) \), FontColor->RGBColor[0, 0, 1]], ";"}]}], "\[IndentingNewLine]", "]"}]}], StyleBox[\( (*end\ \(\(If\)\([\)\(aa ... \)\)*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[",", FontColor->GrayLevel[0]], \({j, l}\)}], "]"}], ";", StyleBox[\( (*end\ \(\(Do\)\([\)\(j\ loop, \ \ res\ completed\)\ \)*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr > 0, Print[{"\", l, mx, my, "\<\n\>", res}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Case - by - case\ combination\ and\ closure*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(tl = {2, my + 1, 0}\), ";", \(tr = {mx - 2, my + 1, 0}\), ";", \(bl = {2, 0, 0}\), ";", \(br = {mx - 2, 0, 0}\), ";", \(tmp = res\), ";", StyleBox[\( (*needed\ for\ links*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{ StyleBox["Which", FontColor->RGBColor[0, 1, 0]], "[", RowBox[{ StyleBox[\(evnod == {0}\), FontColor->RGBColor[0, 1, 0]], ",", \(res[\([1]\)] = pf3[{bl, res[\([1]\)], br, bl}]; res[\([2]\)] = pf3[{tl, res[\([2]\)], tr, tl}]\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {pf3[{bl, res[\([1]\)], tr, tl, res[\([2]\)], br, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {0, 0}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {pf3[{bl, res[\([1]\)], tl, mx - 5/2, my/2 + 3, 0, Reverse[res[\([4]\)]], Reverse[res[\([2]\)]], res[\([3]\)], mx - 5/2, my/2 - 2, 0, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {0, 1}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {pf3[{bl, res[\([1]\)], tl, mx - 5/2, my/2 + 3, 0, Reverse[res[\([3]\)]], res[\([2]\)], res[\([4]\)], mx - 5/2, my/2 - 2, 0, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1, 0}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {pf3[{bl, res[\([1]\)], res[\([4]\)], mx - 5/2, my/2 + 3, 0, tl, Reverse[res[\([2]\)]], res[\([3]\)], mx - 5/2, my/2 - 2, 0, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1, 1}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {{}, {}}; res[\([1]\)] = pf3[{bl, tmp[\([1]\)], tmp[\([4]\)], mx - 5/2, my/2 - 2, 0, bl}]; res[\([2]\)] = pf3[{tl, Reverse[tmp[\([2]\)]], tmp[\([3]\)], mx - 5/2, my/2 + 3, 0, tl}]\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {0, 0, 0}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {{}, {}}; tl = {a[\([1]\)] + 2, my, 0}; bl = {3, \(-1\), 0}; res[\([1]\)] = pf3[{bl, tmp[\([1]\)], tmp[\([5]\)], mx - 5/2, my/2 - 3, 0, bl}]; res[\([2]\)] = pf3[{tl, Reverse[tmp[\([3]\)]], tmp[\([2]\)], tmp[\([4]\)], tmp[\([6]\)], mx - 5/2, my/2 + 3, 0, tl}]\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {0, 0, 1}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {pf3[{4, 0, 0, tmp[\([1]\)], \((tmp[\([1, \(-1\)]\)] + tmp[\([5, 1]\)])\)/2, tmp[\([5]\)], tmp[\([5, \(-1\)]\)] + {\(-2\), 3, 0}, tmp[\([3, \(-1\)]\)] + {2, 1, 0}, Reverse[tmp[\([3]\)]], tmp[\([2]\)], tmp[\([4]\)], \((tmp[\([4, \(-1\)]\)] + tmp[\([6, 1]\)])\)/2, tmp[\([6]\)], tmp[\([6, \(-1\)]\)] + {0, \(-1\), 0}, tmp[\([6, \(-1\)]\)] + {\(-2\), \(-a[\([2]\)]\) - 1, 0}, 4, 0, 0}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {0, 1, 0}\), FontColor->RGBColor[0, 1, 0]], ",", \(tl = tmp[\([4, \(-1\)]\)] + {2, 2, 0}; res = {{}, {}}; res[\([1]\)] = pf3[{4, \(-1\), 0, tmp[\([1]\)], tmp[\([5]\)], mx - 5/2, 2, 0, 4, \(-1\), 0}]; res[\([2]\)] = pf3[{tl, Reverse[tmp[\([4]\)]], Reverse[tmp[\([2]\)]], tmp[\([3]\)], tmp[\([6]\)], tmp[\([6, \(-1\)]\)] + {\(-2\), 2, 0}, tl}]\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {0, 1, 1}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {pf3[{4, 0, 0, tmp[\([1]\)], tmp[\([5]\)], tmp[\([5, \(-1\)]\)] + {\(-2\), 3, 0}, tmp[\([4, \(-1\)]\)] + {2, 1, 0}, Reverse[tmp[\([4]\)]], Reverse[tmp[\([2]\)]], tmp[\([3]\)], \((tmp[\([3, \(-1\)]\)] + tmp[\([6, 1]\)])\)/2, tmp[\([6]\)], tmp[\([6, \(-1\)]\)] + {0, \(-1\), 0}, tmp[\([6, \(-1\)]\)] + {\(-2\), \(-a[\([2]\)]\) - 1, 0}, 4, 0, 0}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1, 0, 0}\), FontColor->RGBColor[0, 1, 0]], ",", \(bl = {4, \(-1\), 0}; res = {pf3[{bl, res[\([1]\)], 2 a[\([1]\)] - 1, 4, 0, res[\([4]\)], 2 a[\([1]\)], my - 2, 0, res[\([6]\)], mx - 3, my/2 + 4, 0, a[\([1]\)] + 2, my, 0, Reverse[res[\([3]\)]], 2, 4, 0, res[\([2]\)], 2 a[\([1]\)] + 3, 4, 0, res[\([5]\)], res[\([5, \(-1\)]\)] + {\(-2\), \(-3\), 0}, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1, 1, 0}\), FontColor->RGBColor[0, 1, 0]], ",", \(bl = {4, \(-1\), 0}; res = {pf3[{bl, res[\([1]\)], res[\([1, \(-1\)]\)] + {\(-1\), 1/2, 0}, res[\([4]\)], res[\([4, \(-1\)]\)] + {2, 2, 0}, tmp[\([6, \(-1\)]\)] + {\(-2\), 3, 0}, Reverse[res[\([6]\)]], tmp[\([6, 1]\)] + {\(-1\), 1, 0}, res[\([3, \(-1\)]\)] + {1, 0, 0}, Reverse[res[\([3]\)]], res[\([2]\)], \((res[\([2, \(-1\)]\)] + res[\([5, 1]\)])\)/2, res[\([5]\)], res[\([5, \(-1\)]\)] + {0, \(-2\), 0}, br, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1, 1, 1}\), FontColor->RGBColor[0, 1, 0]], ",", \(bl = {4, \(-1\), 0}; res = {pf3[{bl, res[\([1]\)], \((res[\([1, \(-1\)]\)] + res[\([4, 1]\)])\)/2, res[\([4]\)], res[\([4, \(-1\)]\)] + {2, 2, 0}, tmp[\([5, \(-1\)]\)] + {\(-2\), 3, 0}, Reverse[ res[\([5]\)]], \((res[\([5, 1]\)] + res[\([2, \(-1\)]\)])\)/2, Reverse[ res[\([2]\)]], \((res[\([2, 1]\)] + res[\([3, 1]\)])\)/2, res[\([3]\)], \((res[\([3, \(-1\)]\)] + res[\([6, 1]\)])\)/2, res[\([6]\)], br, bl}]}\), "\[IndentingNewLine]", ",", StyleBox[\(evnod == {1, 0, 1}\), FontColor->RGBColor[0, 1, 0]], ",", \(res = {{}, {}}; res[\([1]\)] = pf3[{4, \(-1\), 0, tmp[\([1]\)], tmp[\([4]\)], \((tmp[\([4, \(-1\)]\)] + tmp[\([6, 1]\)])\)/2, tmp[\([6]\)], tmp[\([6, \(-1\)]\)] + {\(-a[\([3]\)]\), \ \(-a[\([2]\)]\), 0}, 4, \(-1\), 0}]; res[\([2]\)] = pf3[{tmp[\([2]\)], tmp[\([5]\)], tmp[\([5, \(-1\)]\)] + {\(-a[\([3]\)]\), 2, 0}, tmp[\([3, \(-1\)]\)] + {1, 1, 0}, Reverse[tmp[\([3]\)]], tmp[\([2, 1]\)]}]\), ",", "\[IndentingNewLine]", "True", ","}], "]"}], ";", "\[IndentingNewLine]", "res"}]}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["kPretzel.", FontSlant->"Italic"]], "Subsubsection", PageWidth->PaperWidth], Cell[TextData[{ "\tPretzel links consist of tassels, each with right or left handed \ crossings, effectively running down a vertical cylindrical surface. Each \ tassel is joined at top and bottom to its neighbours. Pretzel knots, \ generated by ", StyleBox["kpretzel[a],", FontSlant->"Italic"], " are restricted to an odd number of odd-crossing-number tassels, or any \ number of odd and one even tassel. Multiple even tassels, or an even number \ of only-odd tassels, create separate links. Two-tassels create ring knots, \ and are rejected by ", StyleBox["kpretzel", FontSlant->"Italic"], "." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["kpretzel", FontColor->RGBColor[0, 1, 0]], "[", \(a_: {3, 3, 3}\), "]"}], ":=", StyleBox[\( (*\(3/6\)/5*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({dz, evn = If[EvenQ[a[\([\(-1\)]\)]], 1, 2], halves, l = Length[a], mn, mx, n = Plus @@ Abs[a], res = {}, seq = {{}, {}, {{1, 4, 5, 3, 2, 6}, {1, 4, 5, 2, 3, 6}}, {{1, 4, 5, 7, 6, 3, 2, 8}}, {{1, 4, 5, 8, 9, 7, 6, 3, 2, 10}, {1, 4, 5, 8, 9, 2, 3, 6, 7, 10}}, {{1, 4, 5, 8, 9, 11, 10, 7, 6, 3, 2, 12}}, {{1, 4, 5, 8, 9, 12, 13, 11, 10, 7, 6, 3, 2, 14}, {1, 4, 5, 8, 9, 12, 13, 2, 3, 6, 7, 10, 11, 14}}, {{1, 4, 5, 8, 9, 12, 13, 15, 14, 11, 10, 7, 6, 3, 2, 16}, {}}}, x1, x2 = 2, x3 = 2, x4 = 2, xt = \(-2\), xd = {0, 1, 0, \(-1\)}, zd = {1, 0, \(-1\), 0}}\), ",", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{ StyleBox[\(If[l < 3, Print\ ["\"]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\(If[EvenQ[l] && OddQ[a[\([\(-1\)]\)]], Print\ ["\", a]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\(If[IntegerQ[Plus @@ a], , Print\ ["\", a]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox[\( (*\ Generates\ a\ Pretzel\ knot\ with\ 3\ to\ 8\ \ \(\(tassels\)\(.\)\)\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 1]], \(mn = Min[Union[Abs[a]]]\), ";", \(mx = Max[Union[Abs[a]]]\), ";", StyleBox[\(If[pr > 8, Print[{a, l, mn, mx, n}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", \(halves = Table[{}, {i, 2 l}]\), ";", StyleBox[\( (*half\ tassels, \ returns*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(x1 = 3 l - 5/2\), ";", \(x4 = x1\), ";", \(If[evn \[Equal] 2 && OddQ[l], x3 = x1; x4 = 2, xt = 2]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Do", "[", RowBox[{ RowBox[{ StyleBox[\(If[EvenQ[a[\([j]\)]] && j \[NotEqual] l, Print\ [{"\", a}]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 1]], \(dy = mx - Abs[a[\([j]\)]]\), ";", StyleBox[\( (*tassel\ centralizer*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Do", "[", RowBox[{ RowBox[{\(dx = xd[\([Mod1[i, 4]]\)]\), ";", StyleBox[\( (*x\ displacement*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(dz = Sign[a[\([j]\)]] zd[\([Mod1[i, 4]]\)]\), ";", StyleBox[\( (*z\ displacement*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(AppendTo[ halves[\([2 j - 1]\)], {3 j + dx - 2, i + dy, dz}]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(AppendTo[ halves[\([2 j]\)], {3 j - dx - 2, i + dy, \(-dz\)}]\)}], ",", \({i, 0, (*\(y\)\(=\)*) 2 Abs[a[\([j]\)]]}\)}], "]"}]}], ",", "\[IndentingNewLine]", \({j, l}\)}], "]"}], ";", StyleBox[\( (*now\ add\ top\ arc*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(AppendTo[ halves[\([xt]\)], {x3, 2 mx + 1, 0}]\), ";", "\[IndentingNewLine]", \(AppendTo[ halves[\([xt]\)], {x4, 2 mx + 1, 0}]\), ";", "\[IndentingNewLine]", \(jj = seq[\([l, evn]\)]\), ";", StyleBox[\( (*tassel\ sequence\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(Do[ h = halves[\([jj[\([j]\)]]\)]; If[EvenQ[j], h = Reverse[h]]; Do[AppendTo[res, h[\([i]\)]], {i, Length[h]}], {j, Length[halves]}]\), ";", StyleBox[\( (*\ add\ bottom\ arc, \ closure*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(AppendTo[res, {x1, \(-1\), 0}]\), ";", "\[IndentingNewLine]", \(AppendTo[res, {x2, \(-1\), 0}]\), ";", \(AppendTo[res, res[\([1]\)]]\), ";", \({res}\)}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "3.9. K2K links, ", StyleBox["blistToBword, K2KShow, nodeListToPdata, PdataToNodeList,", FontSlant->"Italic"], " ", StyleBox["blistDrawKnot, blistFromK2K, plistFromK2K.", FontSlant->"Italic"] }], "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tProf. Mitsuyuki Ochiai's programme Knot2000 (K2K) contains an immense \ database (all simple knots with 9 to 16 crossings and many links, based on \ Prof. Morwen Thistlethwaite's data) and also allows knots and links to be \ created interactively by drawing in a window, using the graphics suite ", StyleBox["OpenGLDraw", FontSlant->"Italic"], ". It can be downloaded from [13] and unpacked into the ", StyleBox["Mathematica", FontSlant->"Italic"], " directory. ", StyleBox["OpenGLDraw.dll", FontSlant->"Italic"], " and ", StyleBox["glut32.dll", FontSlant->"Italic"], " may need to be included. To allow access from KnotsEtc, save ", StyleBox["knotbycomp.nb", FontSlant->"Italic"], " in", StyleBox[" addons\\extrapackages", FontSlant->"Italic"], ". Change the line ", StyleBox["Uninstall[link];", FontSlant->"Italic"], " in ", StyleBox["ShowKnotfromPdata ", FontSlant->"Italic"], "to ", StyleBox["Uninstall[link];If[s==2,ll=mm];", FontSlant->"Italic"], " so that ", StyleBox["ShowKnotfromPdata[plist,2]", FontSlant->"Italic"], " puts the linelist into the global variable ", StyleBox["ll", FontSlant->"Italic"], " without drawing the knot.", " Then create ", StyleBox["knotbycomp.m.\n\t", FontSlant->"Italic"], "The following instruction should now make the K2K routines and data \ available. " }], "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell[BoxData[{ \(SetDirectory["\"]\), "\[IndentingNewLine]", \(<< knotbycomp.m\)}], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \("C:\\Program Files\\Wolfram Research\\Mathematica\\K2K1_3_3"\)], \ "Output"] }, Closed]], Cell[TextData[{ "\tThe following procedures are demonstrated in Examples 36-44.\nK2K [13] \ uses ", StyleBox["bword,", FontSlant->"Italic"], " the most compact braid descriptor, using the letters a-k for overpasses, \ A-K for underpasses. The K2K function ", StyleBox["bwdtonumwd[bword_String]", FontSlant->"Italic"], " creates a ", StyleBox["braidlist", FontSlant->"Italic"], ". The reverse operation is:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(blistToBword[l_List] := Module[{a, ll = Length[l], B = "\<\>", n = "\", N = "\"}, Do[a = l[\([i]\)]; If[a > 0, B = B <> StringTake[n, {a}], B = B <> StringTake[N, {\(-a\)}]], {i, ll}]; B];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell["\<\ \tK2K uses \"plist\" notation for knots. It is the list {{number of \ crossings for each component}, {signed crossing index for the underpasses for \ each crossing}}\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(nodeListToPdata[nod_List] := Module[{l = Length[nod[\([1]\)]], p = {}, q = {}}, AppendTo[p, {l/2}]; \ Do[If[nod[\([1, i, 1]\)] < 0, AppendTo[q, nod[\([1, i, 2]\)]]], {i, l}]; AppendTo[p, q]];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[TextData[{ "\tK2KShow uses ", StyleBox["nodeListToPdata", FontSlant->"Italic"], " to ", "give the K2K plot of a lineList:-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(K2KShow[line_List] := ShowKnotfromPdata[crosscurv[line]; nodeListToPdata[nodeList]]\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(pdataToNodeList[pl_List]\), ":=", StyleBox[\( (*\(22/8\)/5\ Unfinished*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(Module[{a = pl[\([2]\)], ak, k = 0, l = Length[pl[\([1]\)]], m = Length[pl[\([2]\)]], p, pos, q = {}, r, rk, s}, r = Range[2 m]; p = Transpose[{r, r}]; Do[lj = pl[\([1, l]\)]; \[IndentingNewLine]Do[\(k++\); ak = Abs[a[\([k]\)]]; s = Sign[a[\([k]\)]]; p[\([ak, 2]\)] = 2 k\ s; p[\([2 k, 2]\)] = ak\ s; p[\([2 k, 1]\)] = \(-2\) k;, \[IndentingNewLine]{i, lj}]; \[IndentingNewLine]AppendTo[q, p], \[IndentingNewLine]{j, l}]; q]\)}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(\(blistDrawKnot[] := Module[{}, pdata\ = \ GetPdatabyTracking[]; bword = GetBraidRep[pdata]; bwordToblist[bword]];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell["\<\ Individual pList and bword data is recovered from the Thistlethwaite files of \ non-alternate knots with 9 to 16 crossings:-\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(plistFromK2K[cr_Integer: 10, pos_Integer: 1] := (*Accesses\ 201691\ knots\ with\ 9\ to\ 15\ crossings*) \n\t Module[{str = "\" <> ToString[cr] <> "\<.PRD\>", temp}, If[cr < 10 || cr > 15 || cr \[Equal] 10 && pos > 42 || cr \[Equal] 11 && pos > 185 || cr \[Equal] 12 && pos > 888 || cr \[Equal] 13 && pos > 5110 || cr \[Equal] 14 && pos > 27436 || cr \[Equal] 15 && pos > 168030, Print["\", cr, "\< \>", pos]; Abort[]]; \[IndentingNewLine]temp = ReadList[str, Number, \((3 + cr)\)\ pos, RecordLists \[Rule] True]; \[IndentingNewLine]If[temp == $Failed, Print["\", str]; Abort[]]; \[IndentingNewLine]{temp[\([\(-2\)]\)]/2, temp[\([\(-1\)]\)]}\[IndentingNewLine]]\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(blist[cr_Integer: 10, p_Integer: 1] := \n\t Module[ (*426213\ braids\ for\ knots\ with\ 9\ to\ 16\ crossings*) \ \ {str = "\" <> ToString[cr] <> "\<.brd\>", pos = p, temp}, \[IndentingNewLine]If[ cr > 3 && cr < 10 && Length[genKnot[\([cr]\)]] \[GreaterSlantEqual] p, temp = {blistToBword[ genKnot[\([cr, p, 6]\)]]}, \[IndentingNewLine]Which[ cr \[Equal] 15 && pos < 65007, str = "\", \[IndentingNewLine]cr \[Equal] 15 && pos < 103026 + 65006, pos = pos - 65006; str = "\", \[IndentingNewLine]cr \[Equal] 16 && pos < 112126, str = "\", \[IndentingNewLine]cr \[Equal] 16 && pos < 224521, str = "\"; pos = pos - 112125, \[IndentingNewLine]True, If[cr < 10 || cr > 14 || cr \[Equal] 10 && pos > 42 || cr \[Equal] 11 && pos > 185 || cr \[Equal] 12 && pos > 888 || cr \[Equal] 13 && pos > 5110 || cr \[Equal] 14 && pos > 27436, Print["\", Length[temp] - 1, "\< \>", cr, "\< \>", p]; Abort[]]]; temp = ReadList[str, String, pos]; \[IndentingNewLine]If[ temp == $Failed, Print["\", str]; Abort[]]]; temp[\([\(-1\)]\)]\[IndentingNewLine]]\)], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["4. Elementary Knot Theory.", "Section", PageWidth->PaperWidth, FontSize->18], Cell[CellGroupData[{ Cell["4.1. Mathematical Knots and Knot Invariants.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tThe mathematical definition of a knot is \"A closed 3D line that cannot \ be deformed into a simple loop without passing the line through itself.\" \ Links are multiple closed lines; they also are knotted if they cannot be \ deformed into simple loops without passing lines through lines. Knots and \ links can be \"oriented\", with each loop having a direction. In this \ notebook they are intrinsically oriented because they are represented by \ indexed sets of points. \n\tThis notebook was developed to increase my \ understanding of knots. Anyone contemplating research in knot theory should \ use the K2K package [], which includes ThistleThwaites data on knots and \ links with up to 16 crossings, together with many procedures implemented as \ fast applications.\n\tKnot theory is largely based on 2D projections. These \ are called knot diagrams if they indicate under and over at each crossing, \ otherwise they are shadows. The crossings can be found for a given knot \ diagram, using the ", StyleBox["crossings", FontSlant->"Italic"], " procedure (section 4.2). Knot diagrams can be modified, using the \ Reidemeister moves (section 4.3) or rotation (end of section 3) without \ altering the knot topology; this may reduce the number of crossings. The \ minimum number of crossings is a \"knot invariant\". The data in this \ notebook generally creates knot and link diagrams in the xy plane with the \ minimum number of crossings; these diagrams may not be unique as some knots \ have several minimum crossing forms. One minimal form may be converted to \ another by a series of moves; this usually involves non-minimal intermediate \ forms.\n\tThe ", StyleBox["crossings", FontSlant->"Italic"], " & ", StyleBox["crosscurv ", FontSlant->"Italic"], "procedures assigns two signed crossing numbers (under and over) to each \ crossing, in the ", StyleBox["nodeList", FontSlant->"Italic"], ". The first number is negated if it is an underpass; the second number is \ negated if the crossing has a negative orientation i.e. when the overpass \ comes from the right on approaching on the underpass. ", StyleBox["nodeList", FontSlant->"Italic"], " can be manipulated to give the Dowker-Thistlethwaite name, the ", StyleBox["writhe", FontSlant->"Italic"], ", etc." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["4.2. Crossing identification.", "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["4.2.1. Discussion.", "Subsubsection"], Cell[TextData[{ StyleBox["\tcurvs", FontSlant->"Italic"], " generates ", StyleBox["xyz ", FontSlant->"Italic"], "as the coordinate list of the chord starting nodes, with a specified \ starting point. ", StyleBox["xyz", FontSlant->"Italic"], " is the basic data needed for the crossing identification procedure. ", StyleBox["crossings[]", FontSlant->"Italic"], " (or ", StyleBox["crossings[xyz]", FontSlant->"Italic"], ") uses it to find and label crossings, using ", StyleBox["chordno\[RightArrow]2", FontSlant->"Italic"], " (two chords between points) for speed of execution. (", StyleBox["crosscurv[List]", FontSlant->"Italic"], " provides a shortcut, first calling ", StyleBox["curvs", FontSlant->"Italic"], " with suitable options. It also prints out the crossing matrix if ", StyleBox["pr", FontSlant->"Italic"], " =1 or 2, and the Dowker notation for knots if ", StyleBox["pr", FontSlant->"Italic"], " =2 or 3.)\n\tBoth instances of the chord numbers of each crossing found \ in traversing the oriented loops are stored in ", StyleBox["nodeList", FontSlant->"Italic"], "; the first number is negated if it is an overpass chord; the second \ number is negated if the node has negative orientation. The location of the \ chords between crossings is stored in ", StyleBox["chxyz", FontSlant->"Italic"], ". Points are indexed in order, with the same sign convention, in ", StyleBox["nodeList", FontSlant->"Italic"], ". Finally they are put ino the Graphics object ", StyleBox["cr", FontSlant->"Italic"], ", with the crossing indices ", StyleBox["pts", FontSlant->"Italic"], " superimposed. (", StyleBox["curvs", FontSlant->"Italic"], " shows ", StyleBox["point", FontSlant->"Italic"], " indices, not ", StyleBox["crossing ", FontSlant->"Italic"], "indices, on lines.) There is an outstanding problem with links." }], "Text", PageWidth->PaperWidth], Cell[TextData[{ StyleBox[" Crossing procedure.", FontWeight->"Bold"], StyleBox["\ncurvs", FontSlant->"Italic"], " with ", StyleBox["rad->0", FontSlant->"Italic"], " creates ", StyleBox["xyz", FontSlant->"Italic"], " as a list of one or more lines, sets of points with 3 coordinates x, y, \ z. \n", StyleBox["xyz", FontSlant->"Italic"], " is the argument for ", StyleBox["crossings", FontSlant->"Italic"], ". It is flattened to give XYZfl, an ordered list of all the points.\n\ Adjacent points in a line define a chord. If the last point coincides with \ the first, the line is a loop.\nEvery chord has to be compared with all \ subsequent chords to find crossings. A first check is for overlap of the the \ rectangles defined by chord diagonals.\n", StyleBox["linlen", FontSlant->"Italic"], " is a list of last indices (in XYZfl) for each line. It is used to \ identify the (non-chord) jumps between successive lines.\nThe l loop treats \ each line in turn. ", StyleBox["linlen", FontSlant->"Italic"], " is used to find XYZline, the points in the line.\nThe i loop treats each \ chord in the current line. lx is the number of chords. x1 & x2 are the chord \ ends. z1 z2 are corresponding heights\nThe j loop works through all chords \ after x1 x2; \"non-chords\" between loops are skipped, as are those with no \ possible crossing. aa & bb are the position of the intersection of the chords \ being compared. No crossing occurs if they are <0 or \[GreaterEqual]1. (=1 is \ at the beginning of the next chord.)\nThe underpass and the orientation are \ found, and ", StyleBox["node", FontSlant->"Italic"], " is built up as {-j unov, i ori, location} items. This is sorted into ", StyleBox["snode", FontSlant->"Italic"], " by |first number|. The location goes into ", StyleBox["chxyz", FontSlant->"Italic"], ". ", StyleBox["nodeList", FontSlant->"Italic"], " is obtained by converting chord indices into crossing indices, with the \ first index negated at an underpass, second index negated at a crossing with \ negative orientation. ", StyleBox["nodpos", FontSlant->"Italic"], " then plots the indices to the left of the crossing, with the (unsigned) \ overpass index above the underpass index (signed with the orientation). \ Finally, ", StyleBox["cr", FontSlant->"Italic"], " is created as a Graphics object by plotting ", StyleBox["nodpos", FontSlant->"Italic"], " and the chords, which have thickness proportional to ", StyleBox["z", FontSlant->"Italic"], "." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "4.2.2. ", StyleBox["crosscurv, crossings, lineEnds", FontSlant->"Italic"], "." }], "Subsubsection"], Cell[BoxData[ \(Clear[lineEnds, crosscurv, crossings]; xyz =. ;\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["lineEnds", FontColor->RGBColor[0, 1, 0]], "[", "lin_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({l = Table[Length[lin[\([i]\)]], {i, Length[lin]}]}\), ",", RowBox[{\(PrependTo[l, 0]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], \(Do[ l[\([i]\)] += l[\([i - 1]\)], {i, 2, Length[l]}]\), ";", "l"}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["crosscurv", FontColor->RGBColor[0, 1, 0]], "[", StyleBox[\(lines_?ListQ, opts___Rule : {}\), ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[":=", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["Module", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox[\({}\), ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox["curvs", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox["perturb", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], StyleBox["lines", ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(rad -> 0\), ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(chordno -> 2\), ShowStringCharacters->True, NumberMarks->True]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["crossings", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(xyz, opts\), ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["If", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox[\(pr == 1 || pr == 3\), ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["Print", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["{", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["\"\\"", ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["linkMatrix", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox["}", ShowStringCharacters->True, NumberMarks->True]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["If", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox[\(pr == 2 || pr == 3 && Length[lines] == 1\), ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox["Print", ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["{", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["\"\\"", ShowStringCharacters->True, NumberMarks->True], StyleBox[",", ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["dowth", ShowStringCharacters->True, NumberMarks->True, FontColor->RGBColor[0, 1, 0]], StyleBox["[", ShowStringCharacters->True, NumberMarks->True], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox["}", ShowStringCharacters->True, NumberMarks->True]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], StyleBox[\(If[pr \[GreaterSlantEqual] 0, Show[cr]]\), ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox["]", ShowStringCharacters->True, NumberMarks->True]}]}], StyleBox[";", ShowStringCharacters->True, NumberMarks->True]}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ StyleBox["crossings", FontColor->RGBColor[0, 1, 0]], "[", \(xyz_List, opts___Rule : {}\), "]"}], ":=", \( (*\(8/5\)/5*) \), "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"a", ",", "aa", ",", "b", ",", "bb", ",", "len", ",", RowBox[{"linlen", "=", RowBox[{ StyleBox["lineEnds", FontColor->RGBColor[0, 1, 0]], "[", "xyz", "]"}]}], ",", \(d = Length[xyz[\([1, 1]\)]]\), ",", "ii", ",", "iii", ",", \(jj = \(-3\)\), ",", "jjj", ",", "l", ",", "lcount", ",", "m", ",", \(node = {}\), ",", "ori", ",", "snode", ",", "unov", ",", "z", ",", "XYZline", ",", \(XYZfl = Flatten[xyz, 1]\)}], "}"}], ",", StyleBox[\( (*\ wraparound\ indices\ *) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", linlen, "\<\nxyz=\>", xyz, "\<\nXYZfl=\>", XYZfl}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(nodpos = {}\), ";", \(chxyz = {}\), ";", \(siz = Max[XYZfl] - Min[XYZfl]\), ";", "\n", RowBox[{"Do", "[", StyleBox[\( (*\ l\ Loop\ through\ each\ line*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(XYZline = Take[XYZfl, {linlen[\([l - 1]\)] + 1, linlen[\([l]\)]}]\), ";", \(lcount = 0\), ";", "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[{l, linlen[\([l]\)], "\<=l,L[l],new XYZline, lengths=\ \>", XYZline, Length[XYZline]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", StyleBox[\( (*\ Compare\ each\ chord\ in\ this\ line\ with\ all\ \ later\ chords, \ finding\ crossings\ *) \), FontColor->RGBColor[0, 0, 1]], "\n", RowBox[{"Do", "[", StyleBox[\( (*i\ loop\ from\ 1\ to\ line\ end*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(iii = i + linlen[\([l - 1]\)]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(xy1 = Take[\ XYZline[\([i]\)], 2]\), ";", \(xy2 = Take[\ XYZline[\([i + 1]\)], 2]\), ";", \(z1 = \ XYZline[\([i, 3]\)]\), ";", \(z2 = \ XYZline[\([i + 1, 3]\)]\), ";", \(ii = jj\), ";", \(jj = \(-3\)\), ";", \(xmin = Min[xy1[\([1]\)], xy2[\([1]\)]]\), ";", \(xmax = Max[xy1[\([1]\)], xy2[\([1]\)]]\), ";", \(ymin = Min[xy1[\([2]\)], xy2[\([2]\)]]\), ";", \(ymax = Max[xy1[\([2]\)], xy2[\([2]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", i, xy1, xmin, xmax, xy2, ymin, ymax, z1, z2}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", \(j = linlen[\([l - 1]\)] + i\), ";", StyleBox[\( (*index\ in\ XYZfl*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"While", "[", RowBox[{\(\(j++\); j < Length[XYZfl]\), ",", "\[IndentingNewLine]", StyleBox[\( (*from\ chord\ i + 1\ to\ last\ chord, \ seek\ new\ crossing\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], " ", RowBox[{\(XY1 = Take[XYZfl[\([j]\)], 2]\), ";", \(XY2 = Take[XYZfl[\([j + 1]\)], 2]\), ";", StyleBox[\( (*\(skipping\ non - overlaps\ &\)\ between\ lines\ *) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{\(MemberQ[linlen, j] || Min[XY1[\([1]\)], XY2[\([1]\)]] > xmax || Max[XY1[\([1]\)], XY2[\([1]\)]] < xmin || Min[XY1[\([2]\)], XY2[\([2]\)]] > ymax || Max[XY1[\([2]\)], XY2[\([2]\)]] < ymin\), ",", StyleBox[\(Goto[skip]\), FontColor->RGBColor[1, 0, 1]]}], "]"}], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(a =. \), ";", \(b =. \), ";", StyleBox[\(If[pr > 8, Print[{i, i + linlen[\([l - 1]\)], j}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", \(z = FindInstance[ aa\ xy1 + \((1 - aa)\)\ xy2 \[Equal] bb\ XY1 + \((1 - bb)\) XY2, {aa, bb}]\), ";", StyleBox[\(If[pr > 8, Print[ Chop[{"\", i, j, XY1, XY2, z}]]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", RowBox[{"If", "[", RowBox[{\(z != {}\), ",", StyleBox[\( (*\ possible\ crossing\ found\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(a = \((aa /. z)\)[\([1]\)]; b = \((bb /. z)\)[\([1]\)]\), ",", \(a = \(-1\); b = \(-1\)\)}], "]"}], ";", "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[ Chop[{"\", a, b, \((a \[GreaterEqual] 0)\), \((a < 1)\), \((b \[GreaterEqual] 0)\), \((b < 1)\)}]]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", RowBox[{"If", "[", RowBox[{\(\((a \[GreaterEqual] 0)\) && \((a < 1)\) && \((b \[GreaterEqual] 0)\) && \((b < 1)\)\), ",", RowBox[{\(jj = j\), ";", \(lcount++\), ";", "\[IndentingNewLine]", StyleBox[\( (*\ new\ crossing\ found . \ Set\ signs\ etc\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr > 8, Print[ Chop[{"\", i, j, a, b, "\", z1, z2, XYZfl[\([j, 3]\)], XYZfl[\([j + 1, 3]\)]}]]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", \(unov = \(-1\)\), ";", "\n", RowBox[{"If", "[", StyleBox[\( (*over\ if\ zi > zj*) \), FontColor->RGBColor[0, 0, 1]], \(d > 2 && \((a\ z1 + \((1 - a)\) z2 > b\ XYZfl[\([j, 3]\)] + \((1 - b)\) XYZfl[\([j + 1, 3]\)])\), unov = 1\), "]"}], ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\( (*Translate\ x3, x4\ to\ common\ origin\ x1*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", \(xya = XY2 + xy1 - XY1\), ";", "\[IndentingNewLine]", StyleBox[\(If[pr > 8, Print[ Chop[{"\", xya, "\", xy1, xy2}]]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(ori = unov\ Sign[\((xy1[\([2]\)] - xy2[\([2]\)])\) \((xya[\([1]\)] - xy1[\([1]\)])\) - \((xy1[\([1]\)] - xy2[\([1]\)])\) \((xya[\([2]\)] - xy1[\([2]\)])\)]\), ";", \(a = Chop[a\ xy1 + \((1 - a)\)\ xy2]\), ";", "\[IndentingNewLine]", StyleBox[\( (*Add\ crossing\ to\ node*) \ \), FontColor->RGBColor[0, 0, 1]], "\n", \(AppendTo[ node, {iii\ unov, j\ ori, a}]\), ";", \(AppendTo[ node, {\(-j\)\ unov, iii\ ori, a}]\), ";"}]}], "\[IndentingNewLine]", StyleBox[\( (*\(EndIf\)\([\)\(aa >= 0. .. \)\(\ \)*) \), FontColor->RGBColor[0, 0, 1]], "]"}], ";", "\[IndentingNewLine]", StyleBox[\(Label[skip]\), FontColor->RGBColor[1, 0, 1]]}]}], StyleBox[\( (*End\ \(\(While\)\([\)\(j++\)\(\ \ \)\)*) \), FontColor->RGBColor[0, 0, 1]], "]"}]}], ",", \({i, Length[XYZline] - 1}\)}], "]"}], ";"}], "\[IndentingNewLine]", \( (*If[lcount > 0, AppendTo[node, {0, 0}]]*) \), "\[IndentingNewLine]", ",", \({l, 2, Length[linlen - 1]}\)}], "]"}], ";", "\[IndentingNewLine]", \(len = Length[node]\), ";", StyleBox[\(If[len \[Equal] 0, Print["\"]; Abort[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox[\(If[pr > 8, Print[{"\", node // tf}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", \(snode = Sort[node, OrderedQ[{Abs[#1], Abs[#2]}] &]\), ";", \(chxyz = Partition[Flatten[Transpose[Take[Transpose[snode], \(-1\)]]], 2]\), ";", StyleBox[\(If[pr > 8, Print[{"\", snode // tf}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(snode = Transpose[Take[Transpose[snode], 2]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", snode // tf}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", \(jj = 1\), ";", \(jjj = Abs[snode]\), ";", StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[\( (*\ Sort\ nodes\ into\ order\ *) \), FontColor->RGBColor[0, 0, 1]], "\n", \(nodeList = Table[{}, {j, Length[linlen]}]\), ";", \(j = 1\), ";", RowBox[{"Do", "[", RowBox[{ RowBox[{"AppendTo", "[", RowBox[{\(nodeList[\([j]\)]\), ",", RowBox[{\(a = snode[\([i, 1]\)]\), ";", \(b = snode[\([i, 2]\)]\), ";", RowBox[{ "If", "[", \(Abs[a] > linlen[\([j]\)], \(j++\)\), StyleBox[\( (*next\ link*) \), FontColor->RGBColor[0, 0, 1]], "]"}], ";", "\n", " ", \({i\ Sign[a], Sign[b]\ \(Position[jjj, Abs[{b, a}]]\)[\([1, 1]\)]}\)}]}], "]"}], ",", \({i, len}\)}], "]"}], ";", \(nodeList = Rest[nodeList]\), ";", StyleBox[\(If[pr > 8, Print[{"\", nodeList}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", RowBox[{"Do", "[", RowBox[{ RowBox[{"AppendTo", "[", RowBox[{"nodpos", ",", StyleBox[\( (*\ Blank\ the\ nodes\ on\ the\ diagram\ *) \), FontColor->RGBColor[0, 0, 1]], \({{GrayLevel[1], Disk[chxyz[\([i]\)], siz/48]}}\)}], "]"}], ",", "\[IndentingNewLine]", \({i, len}\)}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"Do", "[", RowBox[{ RowBox[{\(a = Sign[snode[\([i, 1]\)]]\), ";", \(b = Sign[snode[\([i, 2]\)]]\), ";", \(If[a > 0, b = 1]\), ";", RowBox[{"AppendTo", "[", RowBox[{"nodpos", ",", StyleBox[\( (*\ Number\ the\ nodes\ on\ the\ diagram\ *) \), FontColor->RGBColor[0, 0, 1]], \({\[IndentingNewLine]Hue[0], Text[i\ b, chxyz[\([i]\)] - {0, \(-siz\)*a/96}]}\)}], "]"}]}], ",", "\[IndentingNewLine]", \({i, len}\)}], "]"}], ";", StyleBox[\(If[pr > 8, Print[{"\", nodpos}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", StyleBox[\( (*\ \(Create\ but\ do\ not\ plot\ the\ chords\ &\)\ \ crossing\ numbers*) \), FontColor->RGBColor[0, 0, 1]], "\t", "\[IndentingNewLine]", StyleBox[\($DisplayFunction\ = \ Identity\), ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], RowBox[{"cr", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{ StyleBox["depthshow", FontColor->RGBColor[0, 1, 0]], "[", "xyz", "]"}], ",", \(Graphics\ [nodpos]\), ",", \(AspectRatio \[Rule] Automatic\), ",", "opts"}], "]"}]}], ";", StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[\($DisplayFunction\ = \ Display[$Display, \ #1]\ &\), ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], ";", "\[IndentingNewLine]", StyleBox["cr", ShowStringCharacters->True, NumberMarks->True]}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["crossings", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[xyz]\), ",", RowBox[{ StyleBox["crossings", FontColor->RGBColor[0, 1, 0]], "[", "xyz", "]"}], ",", \(Abort[]\)}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["4.3. Simplification by Reidermeister Moves.", "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["4.3.1. Discussion.", "Subsubsection"], Cell["\<\ \tReidermeister moves are the basic tools of knot theory. As they alter knot \ diagrams without altering the knot topology, they can be used to simplify \ untidy knots, to convert from one tidy knot to a different-looking version, \ and to prove that properties are knot-invariants. They are only supplied as \ simplification tools in this notebook. R1 undoes a simple twist, removing one \ crossing; R2 straightens a bend that crosses above or below another arc, \ removing both crossings; R3 slides an arc over or under a crossing without \ changing the number of crossings. An R1 simplification can be applied wherever a pair of nodes have the same \ indices, removing an \[Alpha].\ \>", "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "4.2.2. ", StyleBox["R1, R2, R3, Rtidy", FontSlant->"Italic"], "." }], "Subsubsection"], Cell[BoxData[ \(Clear[R1, R2, R3, Rtidy]; nodeList =. ;\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["R1", FontColor->RGBColor[0, 1, 0]], "[", \(sno_: nodeList, n_: 999\), "]"}], ":=", StyleBox[\( (*\(10/4\)/5*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{\({a, b, m = n, nn, t, i, j}\), ",", RowBox[{ StyleBox[\(If[ Head[sno] \[Equal] Symbol || Flatten[sno] \[Equal] {}, Print[{"\", \ sno}]; Return[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(t = Transpose[Flatten[sno, 1]]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Wraparound*) \), FontColor->RGBColor[0, 0, 1]], "\n", \(a = AppendTo[t[\([1]\)], t[\([1, 1]\)]]\), ";", \(b = AppendTo[t[\([2]\)], t[\([2, 1]\)]]\), ";", StyleBox[\( (*Find\ and\ remove\ \[Alpha]\ crossings*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\(If[pr\ > 1, Print[{"\", t, a, b}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", \(i = 1\), ";", RowBox[{"While", "[", RowBox[{\(i < Length[a]\), ",", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", i, "\<,a,b\>", a[\([i]\)], b[\([i + 1]\)], b[\([i]\)], a[\([i + 1]\)], "\", Length[a]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], RowBox[{"If", "[", RowBox[{\(Abs[a[\([i]\)]] \[Equal] Abs[b[\([i + 1]\)]] && Abs[b[\([i]\)]] \[Equal] Abs[a[\([i + 1]\)]]\), ",", StyleBox[\( (*remove\ 2\ nodes*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{\(a = Drop[a, {i}]\), ";", \(a = Drop[a, {i}]\), ";", \(b = Drop[b, {i}]\), ";", \(b = Drop[b, {i}]\), ";", StyleBox[\(If[pr > 8, Print[{"\", a, b}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\(If[m = m - 1; m < 1, i = 9999]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], "\n", \(i -= 1\)}]}], "]"}], ";", "\n", \(i++\)}]}], "]"}], ";", \(Rtidy[a, b]\)}]}], "]"}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["Rtidy", FontColor->RGBColor[0, 1, 0]], "[", \(a_, b_\), "]"}], ":=", RowBox[{"Module", "[", RowBox[{\({u, d, j, nn = Transpose[{a, b}], newnodes}\), ",", RowBox[{\(j = Abs[nn]\), ";", StyleBox[\(If[pr\ > 8, Print[{"\", {{a, b}} // tf}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(newnodes = Table[u = nn[\([i, 1]\)]; d = nn[\([i, 2]\)]; {i\ Sign[u], Sign[d]\ \(Position[j, Abs[{d, u}]]\)[\([1, 1]\)]}, {i, Length[nn] - 1}]\), ";", \({newnodes}\)}]}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[TextData[{ "When two nodes have adjacent first and second indices, and the same ", StyleBox["unov", FontSlant->"Italic"], ", they can be eliminated via an R2 move. The first and second nodes in \ each crossing are put into a & b, with wraparounds. Detected node pairs are \ dropped from a & b; so are the wraparounds." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["R2", FontColor->RGBColor[0, 1, 0]], "[", \(sno_: nodeList, n_: 999\), "]"}], ":=", StyleBox[\( (*\(10/4\)/5*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({a, b, t, i, j, m = n, nn}\), ",", RowBox[{ StyleBox[\(If[ Head[sno] \[Equal] Symbol || Flatten[sno] \[Equal] {}, Print[{"\", \ sno}]; Return[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 1]], \(t = Transpose[Flatten[sno, 1]]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Wraparound*) \), FontColor->RGBColor[0, 0, 1]], "\n", \(a = AppendTo[t[\([1]\)], t[\([1, 1]\)]]\), ";", \(b = AppendTo[t[\([2]\)], t[\([2, 1]\)]]\), ";", StyleBox[\(If[pr\ > 8, Print[{"\", t, "\", a, b}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", \(i = 1\), ";", RowBox[{"While", "[", RowBox[{\(i < Length[a] && Length[a] > 3\), ",", RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", i, "\", a, b}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Find\ \[NotSubset] \ crossings*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], RowBox[{"If", "[", RowBox[{\(\((Sign[a[\([i]\)]] == Sign[a[\([i + 1]\)]])\) && \((Abs[ Abs[b[\([i]\)]] - Abs[b[\([i + 1]\)]]] < 2)\)\), ",", StyleBox[\( (*remove\ \[NotSubset] \ crossings*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", m, i, "\", a[\([i]\)], a[\([i + 1]\)], b[\([i]\)], b[\([i + 1]\)]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", \(j = \(Position[Abs[a], Min[Abs[b[\([i]\)]], Abs[b[\([i + 1]\)]]]]\)[\([1, 1]\)] - 2\), ";", StyleBox[\(If[pr > 8, Print[{"\", j}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], \(a = Drop[a, {i}]\), ";", \(a = Drop[a, {i}]\), ";", "\n", " ", \(b = Drop[b, {i}]\), ";", \(b = Drop[b, {i}]\), ";", "\[IndentingNewLine]", \(If[j > 0, \ a = Drop[a, {j}]; a = Drop[a, {j}]; \ b = Drop[b, {j}]; b = Drop[b, {j}]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", a, b}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\(If[m = m - 1; m < 1, i = 9999]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], "\n", " ", \(i -= 1\)}]}], "]"}], ";", "\n", \(i++\)}]}], "]"}], ";", \(Rtidy[a, b]\)}]}], "]"}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell["\<\ An R3 change can be applied wherever three lines cross in a triple of nodes \ (which therefore have adjacent indices) and one line stays above or below the \ other two. This line slides past the third crossing. This does not remove any \ nodes. The routine processes the first case found, starting at the n'th node.\ \ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["R3", FontColor->RGBColor[0, 1, 0]], "[", \(sno_: nodeList, n_: 1\), "]"}], ":=", StyleBox[\( (*\(10/4\)/5*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({a, b, t, nn, i, j, res}\), ",", RowBox[{ StyleBox[\(If[ Head[sno] \[Equal] Symbol || Flatten[sno] \[Equal] {}, Print[{"\", \ sno}]; Return[]]\), FontColor->RGBColor[1, 0, 1]], StyleBox[";", FontColor->RGBColor[1, 0, 1]], \(t = Transpose[Flatten[sno, 1]]\), ";", StyleBox[\(If[pr\ > 8, Print[{"\", t // tf}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Wraparound*) \), FontColor->RGBColor[0, 0, 1]], "\n", \(a = AppendTo[t[\([1]\)], t[\([1, 1]\)]]\), ";", \(aa = Abs[a]\), ";", \(b = Abs[AppendTo[t[\([2]\)], t[\([2, 1]\)]]]\), ";", \(res = sno[\([1]\)]\), ";", RowBox[{ StyleBox["(*", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox[\(Find\ and\ reverse\ a\), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["|", FontColor->RGBColor[0, 0, 1]], RowBox[{ StyleBox["\[Times]", FontSize->18, FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["crossings", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["after", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["node", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["n", FontColor->RGBColor[0, 0, 1]]}]}], StyleBox["*)", FontColor->RGBColor[0, 0, 1]]}], "\n", \(i = n\), ";", RowBox[{"While", "[", RowBox[{\(i < Length[a]\), ",", RowBox[{\(b1 = b[\([i]\)]\), ";", \(b12 = b1 + 1\), ";", \(b2 = b[\([i + 1]\)]\), ";", \(b21 = b2 + 1\), ";", StyleBox[\(If[pr\ > 8, Print[{"\", i, a[\([i]\)], b1, a[\([i + 1]\)], b2}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], RowBox[{"If", "[", RowBox[{\(\((Sign[a[\([i]\)]] == Sign[a[\([i + 1]\)]])\) && Which[\[IndentingNewLine]Abs[ b[\([b1]\)] - b2] \[Equal] 1 && Abs[b[\([b21]\)] - b1] \[Equal] 1, True, \[IndentingNewLine]b11 = b1 - 1; Abs[b[\([b11]\)] - b2] \[Equal] 1 && Abs[b[\([b21]\)] - b1] \[Equal] 1, True, \[IndentingNewLine]b21 = b2 - 1; Abs[b[\([b11]\)] - b2] \[Equal] 1 && Abs[b[\([b21]\)] - b1] \[Equal] 1, True, \[IndentingNewLine]b11 = b1 + 1; Abs[b[\([b11]\)] - b2] \[Equal] 1 && Abs[b[\([b21]\)] - b1] \[Equal] 1, True, \[IndentingNewLine]True, False]\), ",", RowBox[{ StyleBox[\(If[pr\ > 8, Print[{"\", i, "\", b1, b2, "\", b11, b21, }]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(res[\([i, 2]\)] = b21\), ";", \(res[\([i + 1, 2]\)] = b11\), ";", \(res[\([b1, 2]\)] = b2\), ";", \(res[\([b2, 2]\)] = b1\), ";", \(res[\([b11, 2]\)] = i + 1\), ";", \(res[\([b21, 2]\)] = i\), ";", \(i = 9999\)}], "\[IndentingNewLine]", ",", StyleBox[\(If[pr\ > 8, Print[{"\", i, }]];\), FontColor->RGBColor[1, 0, 0]]}], "\[IndentingNewLine]", "]"}], ";", "\n", \(i++\)}]}], "]"}], ";", \({res}\)}]}], "]"}]}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 4.4. Dowker-Thistlethwaite notation, linkMatrix, writhe, bridgeCount.\ \>", "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["4.4.1. Discussion.", "Subsubsection"], Cell[TextData[{ "The Dowker-Thisthlethwaite notation is a sequence of even node numbers \ forming crossings with the natural sequence of odd numbered nodes. I choose \ the starting node that gives the \"largest\" sequence. Even numbers are \ negated if they are the undercrossing [4, p39] - this is needed for \ non-alternating knots such as k08005. Each node provides a candidate for node \ 1. The maximum difference between the second and the first number in the ", StyleBox["nodeList", FontSlant->"Italic"], " pairings gives ", StyleBox["dtn", FontSlant->"Italic"], ", the location of possible starting nodes; this is used to find the \ largest list. As a negated knot may have a different DT name, ", StyleBox["dowth[-nodeList] ", FontSlant->"Italic"], "should also be calculated. ", StyleBox["dowthl ", FontSlant->"Italic"], "handles links, giving a list containing a sub-list for each loop.\nK2K \ includes a procedure to create knots from the Dowker-Thisthlethwaite name \ (See Example 21 and Section 5.4.) :-" }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(dowth[Adamsfig29]\), "\[IndentingNewLine]", \(\(ShowKnotfromPdata[KnotbyDT[%]];\)\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "4.4.2. ", StyleBox["dowthl, dowth, linkMatrix, bridgeCount, pf, writhe", FontSlant->"Italic"], "." }], "Subsubsection"], Cell[BoxData[ \(nodeList =. ; Clear[writhe, dowth, linkMatrix, bridgeCount];\)], "Input",\ PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["pf", FontColor->RGBColor[0, 1, 0]], "[", \(a_, n_: 2\), "]"}], ":=", \(Partition[Flatten[a], n]\)}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[{ RowBox[{ RowBox[{ StyleBox["dowthl", FontColor->RGBColor[0, 1, 0]], "[", "nodes_List", "]"}], ":=", StyleBox[\( (*\ Find\ link\ DowkerThistlethwaite\[IndentingNewLine]\ Name\ \(24/4\)/5*) \), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{\({a, b, dt, linlen = lineEnds[nodes], pn = pf[nodes], res = {}}\), ",", RowBox[{\(a = \(Transpose[pn]\)[\([1]\)]\), ";", \(b = Abs[\(Transpose[pn]\)[\([2]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", a, b, "\", linlen}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", RowBox[{"Do", "[", StyleBox[\( (*j, \ links*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(l0 = linlen[\([j - 1]\)] + 1\), ";", \(l1 = linlen[\([j]\)]\), ";", \(AppendTo[res, {}]\), ";", "\[IndentingNewLine]", RowBox[{"Do", "[", StyleBox[\( (*\ odd\ i\ *) \), FontColor->RGBColor[0, 0, 1]], \(AppendTo[ res[\([\(-1\)]\)], \(-b[\([i]\)]\)\ Sign[ a[\([i]\)]]], \[IndentingNewLine]{i, linlen[\([j - 1]\)] + 1, linlen[\([j]\)], 2}\), "]"}]}], ",", \({j, 2, Length[linlen]}\)}], "]"}], ";", "res"}]}], "]"}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["dowthl", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["dowthl", FontColor->RGBColor[0, 1, 0]], "[", "nodeList", "]"}], ",", "res"}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ StyleBox["dowth", FontColor->RGBColor[0, 1, 0]], "[", "nodes_List", "]"}], ":=", StyleBox[\( (*\ Find\ Knot\ Dowker - Thistlethwaite\ Name\ \(23/4\)/5*) \), FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], RowBox[{"Module", "[", RowBox[{\({a, b, linlen = lineEnds[nodes], pn = pf[nodes], res = {}}\), ",", RowBox[{\(a = \(Transpose[pn]\)[\([1]\)]\), ";", \(b = Abs[\(Transpose[pn]\)[\([2]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", a, b, "\", linlen}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\n", " ", RowBox[{"Do", "[", StyleBox[\( (*j, \ links*) \), FontColor->RGBColor[0, 0, 1]], RowBox[{ RowBox[{\(l0 = linlen[\([j - 1]\)] + 1\), ";", \(l1 = linlen[\([j]\)]\), ";", "\[IndentingNewLine]", RowBox[{"Do", "[", StyleBox[\( (*\ odd\ i\ *) \), FontColor->RGBColor[0, 0, 1]], \(AppendTo[ res, \(-b[\([i]\)]\)\ Sign[ a[\([i]\)]]], \[IndentingNewLine]{i, linlen[\([j - 1]\)] + 1, linlen[\([j]\)], 2}\), "]"}]}], ",", \({j, 2, Length[linlen]}\)}], "]"}], ";", "res"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["dowth", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["dowth", FontColor->RGBColor[0, 1, 0]], "[", "nodeList", "]"}], ",", "res"}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ StyleBox["linkMatrix", FontColor->RGBColor[0, 1, 0]], "[", "sno_List", "]"}], ":=", \(Module[{a, b, l = Length[sno], j1 = 1, l1 = 1, linlen = lineEnds[sno], res, sn = Flatten[sno, 1]}, \[IndentingNewLine]If[l \[Equal] 0, res = {{}}, \[IndentingNewLine]res = Table[0, {i, l}, {j, l}]; \[IndentingNewLine]Do[ b = sn[\([i, 2]\)]; a = Abs[b]; j1 = 0; While[a > linlen[\([j1 + 1]\)] && j1 < l, \(j1++\)]; \[IndentingNewLine]a = Max[l1, j1]; c = Min[l1, j1]; \[IndentingNewLine]res[\([c, a]\)] += Sign[b]; If[c \[NotEqual] a, \(res[\([a, c]\)]++\)]; If[MemberQ[linlen, i], \(l1++\)], {i, Length[sn]}]]; res/2 // tf]\)}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["linkMatrix", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["linkMatrix", FontColor->RGBColor[0, 1, 0]], "[", "nodeList", "]"}], ",", \(Abort[]\)}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[TextData[{ "The writhes are the sums of the signs of the orientations of the crossings \ of individual link. The diagonal of ", StyleBox["linkMatrix", FontSlant->"Italic"], " gives the writhe of each component." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["writhe", FontColor->RGBColor[0, 1, 0]], "[", "nod_List", "]"}], ":=", \(Plus @@ Table[Sign[nod[\([1, i, 2]\)]], {i, Length[nod[\([1]\)]]}]\)}], ";", RowBox[{ RowBox[{ StyleBox["writhe", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["writhe", FontColor->RGBColor[0, 1, 0]], "[", "nodeList", "]"}], ",", \(Abort[]\)}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["writhelink", FontColor->RGBColor[0, 1, 0]], "[", "nod_List", "]"}], ":=", \(Table[\(linkMatrix[nod]\)[\([1, i, i]\)], {i, Length[nod]}]\)}], ";", RowBox[{ RowBox[{ StyleBox["writhelink", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["writhelink", FontColor->RGBColor[0, 1, 0]], "[", "nodeList", "]"}], ",", \(Abort[]\)}], "]"}]}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ StyleBox["bridgeCount", FontColor->RGBColor[0, 1, 0]], "[", "nodes_List", "]"}], ":=", \(Module[{a, c = 0, i = 1, nod = pf[nodes]}, a = Sign[\(Transpose[AppendTo[nod, nod[\([1]\)]]]\)[\([1]\)]]; While[i < Length[a], If[a[\([i]\)] < 0, , If[a[\([i + 1]\)] < 0, \(c++\)]]; \(i++\)]; c]\)}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox["bridgeCount", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["bridgeCount", FontColor->RGBColor[0, 1, 0]], "[", "nodeList", "]"}], ",", \(Abort[]\)}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["4.5. Knot Graphs.", "Subsection", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["4.5.1. Discussion.", "Subsubsection"], Cell[TextData[{ "\tIn \"chequered\" knot diagrams, black regions alternate with white, the \ \"outside\" being white.\n\t", StyleBox["knotGraph[nodelist,par]", FontSlant->"Italic"], " creates a knot graph from a knot or link diagram by creating \"vertices\" \ corresponding to each black region. Initially at the mean of their defining \ nodes, they are scaled by ", StyleBox["Abs[par]", FontSlant->"Italic"], " (typically 1.2) to improve appearance. The argument ", StyleBox["blk=Sign[par]", FontSlant->"Italic"], " is \[PlusMinus]1 to put the outside on the left or right of the first \ chord, and must be negated if the first choice makes the outside black. \n\t\ The vertices have \"signed edges\" through every shared crossing. The edge \ sign is the crossing orientation; red lines are through negative crossings, \ black through positive crossings. Multiple edges occur wherever white regions \ have only two nodes (i.e. they are bounded by only two lines). ", StyleBox["Show[kgshow] ", FontSlant->"Italic"], "shows the vertices and edges superimposed on the graph shadow. A \ simplified graph is output as a ", StyleBox["Combinatorica ", FontSlant->"Italic"], " graph object ", StyleBox["kgraf", FontSlant->"Italic"], ", which can be shown via ", StyleBox["ShowGraph[kgraf]", FontSlant->"Italic"], ". Loops with no crossings are {{0,0}}; they become isolated vertices near \ the centre of ", StyleBox["kgraf", FontSlant->"Italic"], " but are omitted from ", StyleBox["kgshow", FontSlant->"Italic"], ". " }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "4.4.2. ", StyleBox["knotGraph", FontSlant->"Italic"], "." }], "Subsubsection"], Cell[BoxData[ \(ER = EdgeColor \[Rule] RGBColor[1, 0, 0]; V1 = VertexLabel -> "\<1\>"; V2 = VertexLabel -> "\<2\>"; V3 = VertexLabel -> "\<3\>"; V4 = VertexLabel -> "\<4\>"; V5 = VertexLabel -> "\<5\>"; V6 = VertexLabel -> "\<6\>"; V7 = VertexLabel -> "\<7\>"; V8 = VertexLabel -> "\<8\>"; V9 = VertexLabel -> "\<9\>";\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(nodeList =. ; Clear[knotGraph];\)], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ StyleBox["knotGraph", FontColor->RGBColor[0, 1, 0]], "[", \(nodes_List, \ par_: 1.2\), "]"}], ":=", StyleBox[\( (*Create\ graph\ from\ nodeList\ and\ chxyz\ \(17/5\)/ 5*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{\(a = Abs[\(Transpose[pf[nodes]]\)[\([2]\)]]\), ",", "b", ",", \(blk = Sign[par]\), StyleBox[\( (*\(\(|\)\(par\)\(|\)\(\ \)\(is\ scaling\ \ factor\)\), \ \(blk\ switches\ black\ &\)\ white\ regions*) \), FontColor->RGBColor[0, 0, 1]], ",", "c", ",", "id", ",", "d", ",", "dir", ",", "j", ",", "k", ",", "l", ",", \(mxy = Plus @@ chxyz\), StyleBox[\( (*midpoint*) \), FontColor->RGBColor[0, 0, 1]], ",", \(pn = pf[nodes]\)}], \( (*\(,\)\(PS\)*) \), "}"}], ",", "\[IndentingNewLine]", RowBox[{\(bl = {}\), ";", \(l = Length[pn]\), ";", \(mxy = mxy/l\), ";", \(id = Table[Min[Abs[pn[\([i]\)]]], {i, l}]\), StyleBox[\( (*id\ is\ least\ of\ the\ two\ indices*) \), FontColor->RGBColor[0, 0, 1]], ";", \(s = Table[Sign[pn[\([i, 1]\)] pn[\([i, 2]\)]], {i, l}]\), ";", \(vrtx = {}\), ";", \(edgs = {}\), ";", \(comb1 = {}\), ";", \(comb2 = {}\), ";", StyleBox[\(If[pr > 8, Print[{"\", id, a, mxy}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], StyleBox[\( (*Remove\ {{0, 0}}\ unlinked\ loops\ and\ add\ to\ *) \), FontColor->RGBColor[0, 0, 1]], \(b = Position[pn, {{0, 0}}]\), ";", \(d = Length[b]\), ";", \(l = l - d\), ";", \(pn = Drop[pn, b]\), ";", \(Do[ee = \((i - d/2)\) mxy/l; AppendTo[comb2, {ee}], {i, d}]\), ";", "\[IndentingNewLine]", \(Do[b = {id[\([i]\)]}; j = i + 1; b = {}; k = 0; dir = blk; od = If[OddQ[i], 1, \(-1\)]; \[IndentingNewLine]While[\(\(k++\); AppendTo[b, id[\([j]\)]]; j0 = j; j = Mod[ a[\([j0]\)] + \((dir = blk\ od\ dir\ s[\([j0]\)])\), l, 1]; \(! MemberQ[b, id[\([j]\)]]\) && k < 99\)\(,\)]; \[IndentingNewLine]b = Sort[b]; If[MemberQ[bl, b], , \(AppendTo[bl, b];\)];\[IndentingNewLine], {i, l - 1}]\), ";", \(l = Length[bl]\), ";", StyleBox[\(If[pr > 8, Print[{"\", bl, l}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", StyleBox[\( (*\(Find\ &\)\ plot\ Vertices*) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(bxy = {}\), ";", \(Do[ AppendTo[bxy, ee = \((Abs[ par]\ \((\(-mxy\) + Plus @@ chxyz[\([bl[\([i]\)]]\)])\) + mxy)\)/ Length[bl[\([i]\)]]]; AppendTo[comb2, {Round[2 ee]}], {i, l}]\), ";", \(vrtx = ListPlot[bxy, PlotStyle -> PointSize[ .02], DI]\), ";", StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], StyleBox[\( (*\(Find\ &\)\ plot\ Edges*) \), FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{"Do", "[", RowBox[{ RowBox[{"Do", "[", RowBox[{ RowBox[{\(ee = Intersection[bl[\([i]\)], bl[\([j]\)]]\), ";", StyleBox[\(If[pr > 8, Print[{"\", i, j, ee}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], RowBox[{"Do", "[", RowBox[{ RowBox[{ StyleBox[\(If[pr > 8, Print[{"\", bxy[\([i]\)], chxyz[\([k]\)], bxy[\([j]\)]}]]\), FontColor->RGBColor[1, 0, 0]], StyleBox[";", FontColor->RGBColor[1, 0, 0]], \(If[ Sign[pn[\([ee[\([k]\)], 2]\)]] < 0, AppendTo[comb1, {{i, j}, ER}], AppendTo[comb1, {{i, j}}]]\), ";", \(AppendTo[edgs, ListPlot[{bxy[\([i]\)], chxyz[\([ee[\([k]\)]]\)], bxy[\([j]\)]}, DI, Axes \[Rule] False, PlotJoined \[Rule] True]]\)}], ",", \({k, Length[ee]}\)}], "]"}]}], ",", "\[IndentingNewLine]", \({j, i + 1, l}\)}], "]"}], ",", "\[IndentingNewLine]", \({i, l - 1}\)}], "]"}], ";", \(kgshow = {gcurv, vrtx, edgs}\), ";", "\[IndentingNewLine]", StyleBox[\($DisplayFunction\ = \ Display[$Display, \ #1]\ &\), ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowStringCharacters->True, NumberMarks->True], StyleBox[";", ShowStringCharacters->True, NumberMarks->True], "\[IndentingNewLine]", \(kgraf = Graph[comb1, comb2]\)}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{ StyleBox["knotGraph", FontColor->RGBColor[0, 1, 0]], "[", \(par_?NumberQ\), "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["knotGraph", FontColor->RGBColor[0, 1, 0]], "[", \(nodeList, par\), "]"}], ",", "res"}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{ StyleBox["knotGraph", FontColor->RGBColor[0, 1, 0]], "[", "]"}], ":=", RowBox[{"If", "[", RowBox[{\(ListQ[nodeList]\), ",", RowBox[{ StyleBox["knotGraph", FontColor->RGBColor[0, 1, 0]], "[", \(nodeList, 1.3\), "]"}], ",", "res"}], "]"}]}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[TextData[{ StyleBox["knotGraph", FontSlant->"Italic"], " p", "rocedure.\nRemove isolated links. For each node ", StyleBox["i", FontSlant->"Italic"], " but the last, put ", StyleBox["id[[i]]", FontSlant->"Italic"], " (the smaller of the node indices) into ", StyleBox["b", FontSlant->"Italic"], ", advance to ", Cell[BoxData[ FormBox[ RowBox[{"j", "=", RowBox[{"i", StyleBox["+", FontSlant->"Italic"], StyleBox["1", FontSlant->"Italic"]}]}], TraditionalForm]]], ". (", StyleBox["id", FontSlant->"Italic"], " has to be used to identify a node, as each node has two indices.)\nWhile \ Loop; ", StyleBox["j0=j.", FontSlant->"Italic"], " Find the absolute value of the node's other index ", StyleBox["j=a[[j0]] ", FontSlant->"Italic"], "and its sign ", StyleBox["s[[j0]]", FontSlant->"Italic"], ". This is + if ", StyleBox["j", FontSlant->"Italic"], " is on the overpass to a +ve node, or the underpass to a -ve node. In each \ case the next node is ", StyleBox["j=j0+od dir s[[j0]]", FontSlant->"Italic"], " ; ", StyleBox["od", FontSlant->"Italic"], " makes it alternately on the left & right. (", StyleBox["dir", FontSlant->"Italic"], " is updated each time.) If ", StyleBox["j", FontSlant->"Italic"], " is new, add ", StyleBox["id[[j]]", FontSlant->"Italic"], " to ", StyleBox["b.", FontSlant->"Italic"], " Repeat (unless ", StyleBox["k", FontSlant->"Italic"], " shows an error) until ", StyleBox["j0=i", FontSlant->"Italic"], ".\nSort ", StyleBox["b", FontSlant->"Italic"], ", and add to ", StyleBox["bl", FontSlant->"Italic"], " if not already there. (A more efficient, non-exhaustive, search is \ desirable!) Convert ", StyleBox["bl", FontSlant->"Italic"], " to points at the mean of the location of the nodes. (Scaled by ", StyleBox["Abs[par]", FontSlant->"Italic"], " from the centroid as a crude correction for crescentic 2-node regions \ etc). Create signed edges between the vertices and through the nodes. ", StyleBox["kgshow", FontSlant->"Italic"], " superimposes the graph on the", StyleBox[" crosscurv", FontSlant->"Italic"], " graph ", StyleBox["gcurv", FontSlant->"Italic"], ", with edges passing through the appropriate nodes, and can be seen via ", StyleBox["Show[kgshow]", FontSlant->"Italic"], ". The output is a ", StyleBox["Combinatorica", FontSlant->"Italic"], " graph ", StyleBox["kgraf", FontSlant->"Italic"], ", which can be shown via ", StyleBox["ShowGraph[kgraf]", FontSlant->"Italic"], ".\nThe procedure fails with some knots, and with links - unsolved \ problem." }], "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["4.6. Kauffman Bracket, Jones Polynomial, Etc. ", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tKauffman Bracket polynomials are invariants that distinguish between \ most knots. The Jones & HOMFLY polynomials are related knot invariants. \ Bracket polynomials should be calculable recursively by reduction of a ", StyleBox["nodeList", FontSlant->"Italic"], " list to sets of unknots. Rule BP1 says an empty list is an unknot, with \ p=1. If the first or last element of a link list is {}, rule BP2 says \ p=1(AA+1/AA). The general case is BP3, which takes a crossing and \ splits it into A L +1/A R.\n\t[11] & [12] provide non-", StyleBox["Mathematica", FontSlant->"Italic"], " programmes that calculate Jones from Braids & HOMFLY from knots and \ links. K2K [13] includes .exe programmes (demonstrated in Examples 40 & 41) \ that calculate the main polynomials. (My attempts to programme the procedures \ all failed.)" }], "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["5. Data for various Curves, Loops, Bends, etc.", "Section", PageWidth->PaperWidth, FontSize->18], Cell[TextData[{ "Most of these are 3D with negative underpass z coordinates, for clarity in \ the 2D ", StyleBox["rad\[RightArrow]0 ", FontSlant->"Italic"], "plots." }], "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["5.1. An arbitrary selection.", "Subsection"], Cell[BoxData[ \(\(sq = {{{0, 1}, {1, 0}, {0, \(-1\)}, {\(-1\), 0}, {0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(ring = {{{0, 1, 0}, {1, 0, 1}, {0, \(-1\), 0}, {\(-1\), 0, \(-1\)}, {0, 1, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(simple = {{{0, \(-2\), 1}, {1.7, 1, \(-1\)}, {0, 4, 0}, {\(-1.7\), 1, 1}, {0, \(-2\), \(-1\)}, {3.45, \(-2\), 0}, {1.7, 1, 1}, {\(-1.7\), 1, \(-1\)}, {\(-3.45\), \(-2\), 0}, {0, \(-2\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(simplelh = {{{0, \(-2\), \(-1\)}, {1.7, 1, 1}, {0, 4, 0}, {\(-1.7\), 1, \(-1\)}, {0, \(-2\), 1}, {3.45, \(-2\), 0}, {1.7, 1, \(-1\)}, {\(-1.7\), 1, 1}, {\(-3.45\), \(-2\), 0}, {0, \(-2\), \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(simple2 = (*\ \([4]\)\ Fig .3 .11 a*) \[IndentingNewLine]{{{\(-4\), 0, 0}, {\(-2\), \(-2\), 1}, {1, \(-1\), \(-1\)}, {0, .5, 0}, {\(-1\), \(-1\), 1}, {2, \(-2\), 1}, {4, 0, 0}, {2, 2, \(-1\)}, {\(-1\), 1, \(-1\)}, {0, \(- .5\), 0}, {1, 1, 1}, {\(-2\), 2, 0}, {\(-4\), 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(simple4 = {{{ .5, \(-1.5\), .5, \(-1.5\)}, {2, 1.5, \(-1.75\), 0}, {1, 4, .5, 2}, {\(-2\), 5, 2, 0}, {\(-2\), 1.5, .5, \(-2.5\)}, {\(- .5\), \(-1.5\), \(-2\), \(-1.5\)}, \ {3, \(-1\), \(- .5\), .5}, {3, 0, .25, 0}, {1, 1.5, \(-1.25\), \(-2\)}, {\(-2\), 2, \(-1\), \(- .5\)}, {\(-3\), 0, 1, 1}, {\(-2\), \(-2.005\), 1.3, 0}, { .5, \(-1.5\), .5, \(-1.5\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unknot1 = {{{0, 0, 1}, {1, 1, 1/2}, {1, \(-1\), \(-1\)/2}, {0, 0, \(-1\)}, {\(-1\), 1, \(-1\)/2}, {\(-1\), \(-1\), 1/2}, {0, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unknot2 = {{{0, 0, 1}, {1, 1, 1/2}, {2, 0, 1}, {3, \(-1\), 1/2}, {3, 1, \(-1\)/2}, {2, 0, \(-1\)}, {1, \(-1\), \(-1\)/2}, {0, 0, \(-1\)}, {\(-1\), 1, \(-1\)/2}, {\(-1\), \(-1\), 1/2}, {0, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unknot2a = {{{0, 0, 0}, {1, 1, 0}, {1, 0, 1/2}, { .1, 1, 1}, { .5, 2, 1}, {2, 2, 0}, {3. , 1, 0}, {4, 0, 0}, {4, 1, 1}, {3.1, 0, 1}, {2, \(-1\), 1}, { .5, \(-1\), 0}, {0, 0, 0}}};\)\)], "Input",\ PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unknot3 = {{{0, \(-2\), 1}, {1.7, 1, 1}, {0, 4, 1}, {\(-1.7\), 1, .5}, {0, \(-2\), 0}, {3.45, \(-2\), \(-1\)}, {1.7, 1, \(-1\)}, {\(-1.7\), 1, \(- .5\)}, {\(-3.45\), \(-2\), 0}, {0, \(-2\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unknot7 = (*\([4]\) p16*) \[IndentingNewLine]{{{0, 0, 1}, {3, 1, 1}, {3, 5, 1}, {0, 6, 1}, {\(-1\), 5, \(-1\)}, {0, 4, 0}, {1, 5, 1}, {0, 6, \(-1\)}, {\(-3\), 5, 0}, {\(-3\), 1, 0}, {0, 0, \(-1\)}, {2.5, 2, 0}, {1, 3, 1}, {0, 2, \(-1\)}, {\(-1\), 1, 0}, {\(-2\), 3, 0}, {0, 5, 0}, {2, 3, 0}, {1, 1, 0}, {0, 2, 1}, {\(-1\), 3, \(-1\)}, {\(-2.5\), 2, 0}, {0, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(fig8 = {{{0, .2, .4}, { .5, 1, 0}, {0, 1.5, \(- .3\)}, {\(-1\), 1.1, \(- .1\)}, {\(- .6\), \(- .6\), .05}, { .6, \(- .6\), \(- \ .05\)}, {1, 1.1, .1}, {0, 1.5, .3}, {\(- .5\), 1, 0}, {0, .2, \(- .5\)}, { .6, \(- .7\), .4}, {0, \(-1.5\)\ \ , 0}, {\(- .6\), \(- .7\), \(- .4\)}, {0, .2, .4}}};\)\)], \ "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(fig8a = (*\ \([4]\)\ Fig .3 .11 b*) \[IndentingNewLine]{{{0, 0, 0}, {3, 2, 1}, {5, 0, 1}, {3.5, \(-1\), 1}, {2, 0, 0}, {5, 2, \(-1\)}, {6, 0, \(-1\)}, {4.5, \(-1\), \(-1\)}, {3, 0, 1}, {2, 1, 1}, {1, 0, 1}, {3, \(-2\), 1}, {6, \(-2\), 1}, {7, 0, 1}, {5.5, 1, 0}, {4, 0, \(-1\)}, {2, \(-1\), \(-1\)}, {0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Afig6o7 = (*\([4]\) writhe\ example*) \[IndentingNewLine]{{{0, 0, \(-1\)}, {2, 2, \(-1\)}, {4.5, 2.5, 0}, {4, 0, 1}, {2, \(-2\), \(-1\)}, {0, \(-2.5\), \(-1\)}, {\(-2\), \ \(-2\), \(-1\)}, {\(-4\), 0, 1}, {\(-4.5\), 2.5, 0}, {\(-2\), 2, \(-1\)}, {0, 0, 1}, {2, \(-2\), 1}, {4.5, \(-2.5\), 0}, {4, 0, \(-1\)}, {2, 2, 1}, {0, 2.5, 1}, {\(-2\), 2, 1}, {\(-4\), 0, \(-1\)}, {\(-4.5\), \(-2.5\), 0}, {\(-2\), \(-2\), 1}, {0, 0, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(R3test = {{{0, 0, 1}, {1, 1, 1}, {0, 2, 1}, {\(-1\), 1, 0}, {0, 0, \(-1\)}, {2, 0, 0}, {3, 1, 1}, {5, 0, 1}, {3, \(-1\), 1}, {2, 0, 1}, {1, 1, .5}, {\(-1\), 1, 0}, {\(-2\), 0, \(-1\)}, {\(-3\), \(-1\), 0}, {\(-5\), 0, .5}, {\(-3\), 1, 1}, {\(-2\), 0, 1}, {0, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(R3test1 = {{{0, 0, 0}, {1, 1, 1}, {0, 3, 1}, {\(-1\), 1, 1}, {1, \(- .5\), 0}, {3, 0, 0}, {5, 1, 0}, {5, 0, 1}, {2, \(-2\), 0}, (*\(10\)\(\[RightArrow]\)*) {1.5, .5, \(-1\)}, {4, 0, \(-1\)}, {2.5, \(-1\), 1}, {2, 2, 2}, {0, 2, 1}, {\(- .5\), 1, 0}, {0, .5, 0}, {0, 1.5, .5}, {\(-2\), 0, 0}, {0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(R3test2 = {{{0, 0, 0}, {1, 1, 1}, {0, 2, 1}, {\(-1\), 1, 1}, {0, \(- .5\), .5}, {2.5, (*0*) 1, 0}, {5, 1, 1}, {5, 0, 1}, {3, \(- .5\), 0}, {3, 1, \(-1\)}, {4, 0, \(-1\)}, {2.5, \(-1\), 0}, {1.5, 1, 1}, {0, 1.5, 0}, {\(- .5\), 1, 0}, {0, .5, 0}, {0, 1, .5}, {\(-2\), 1.5, 0} (*\(,\)\({\(-2\), 0, \(-1\)}\)\(,\)\({\(-3\), \(-1\), 0}\)\(,\)\({\(-5\), 0, .5}\)\(,\)\({\(-3\), 1, 1}\)\(,\)\({\(-2\), 0, 1}\)*) , {0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(circl3d = {{{0, 1, 0}, {1, 0, 1}, {0, \(-1\), 0}, {\(-1\), 0, \(-1\)}, {0, 1, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(p3d = {{{0, .1, .7}, { .5, .5, .1}, {1, .1, .9}, { .8, .4, 1}, { .2, .8, .8}, {0, .1, .7}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(p4d = {{{0, .1, .7, .3}, { .5, .5, .1, .4}, {1, .1, .9, .3}, \ { .8, .4, 1, .2}, { .2, .8, .8, .25}, {0, .1, .7, .3}}};\)\)], "Input",\ PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(curly = {{{1, 1, 8}, {0, 4, 7}, {0, 6, 5}, {1, 8, 3}, {2, 7, 4}, {1, 5, 6}, {2, 3, 7}, {4, 4, 6}, {3, 6, 6}, {3, 7, 7}, {4, 6, 8}, {5, 6, 9}, {5, 7, 8}, {4, 8, 9}, {3, 9, 5}, {4, 10, 0}, {6, 9, 2}, {7, 5, 0}, {5, 0, 1}, {3, 2, 4}, {2, 0, 6}, {1, 1, 8}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(hypercube4 = (*Traversal\ of\ 16\ corners\ of\ hypercube\ *) \[IndentingNewLine]{{{0, 0, 0, 0}, {0, 0, 1, 0}, {0, 1, 1, 0}, {0, 1, 0, 0}, {1, 1, 0, 0}, {1, 1, 1, 0}, {1, 0, 1, 0}, {1, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 1}, {0, 1, 1, 1}, {0, 1, 0, 1}, {1, 1, 0, 1}, {1, 1, 1, 1}, {1, 0, 1, 1}, {1, 0, 0, 1}, {0, 0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(twolink = {{{1, 8, 1}, {2, 7, 2}, {3, 5, 3}, {2, 4, 3}, {3, 3, 2}, {4, 5, 1}, {5, 6, 0}, {3, 7, \(-1\)}, {3, 8, \(-2\)}, {4, 9, \(-2\)}, {5, 10, \(-1\)}, {6, 9, 2}, {7, 5, 3}, {5, 1, 1}, {3, 2, 0}, {0, 2\ \ \ , \(-1\)}, {1, 8, 1}}, {{1.5, 0.5, \(- .2\)}, {6.5, 0.5, .5}, {6.5, 6.5, 0}, {1.5, 6.5, 0}, {1.5, 0.5, \(- .2\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["5.2. Bends.", "Subsection"], Cell[BoxData[ \(\(reef = {{{0, .3}, { .6, .35}, {1, .6}, {0, .7}, {\(-1\), .6}, \ {\(- .7\), .25}, {0, .3}, { .6, .35}, { .6, \(- .35\)}, {0, \(- .3\)}, \ {\(- .7\), \(- .25\)}, {\(-1\), \(- .7\)}, {0, \(- .8\)}, {1, \(- .7\)}, \ {0.6, \(- .35\)}, {0, \(- .3\)}, {\(- .7\), \(- .25\)}, {\(- .7\), .25}}};\)\ \)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(reef3d2 = {{{\(-6\), .4, 0}, {\(-4\), .4, 0}, {\(-3\), .4, 0}, {\(-2\), .45, \(- .1\)}, {\(-1\), .6, \(- .1\)}, {0, 1.3, .5}, {1, 1.3, 0}, {1.6, 0, \(- .5\)}, {1, \(-1.3\), 0}, {0, \(-1.3\), .5}, {\(-1\), \(- .6\), \(- .1\)}, {\(-2\), \ \(- .45\), \(- .1\)}, {\(-3\), \(- .4\), 0}, {\(-4\), \(- .4\), 0}}, {{6, .4, 0}, {4, .4, 0}, \ \ {3, .4, 0}, {2, .45, .1}, {1, .6, .1}, \ \ {0, 1.3, \(- .5\)}, {\(-1\), 1.3, 0}, {\(-1.6\), 0, .5}, {\(-1\), \(-1.3\), 0}, {0, \(-1.3\), \(- .5\)}, {1, \(- .6\), .1}, {2, \(- .45\), \ .1}, {3, \(- .4\), 0}, {4, \(- .4\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(thiefs = {{{\(-3.5\), .4, 0}, {\(-3\), .4, 0}, {\(-2\), .45, \(- .1\)}, {\(-1\), .6, \(- .1\)}, {0, 1.3, .5}, {1, 1.3, 0}, {1.6, 0, \(- .5\)}, {1, \(-1.3\), 0}, {0, \(-1.3\), .5}, {\(-1\), \(- .6\), \(- .1\)}, {\(-2\), \ \(- .45\), \(- .1\)}, {\(-3\), \(- .4\), 0}, {\(-4\), \(- .4\), 0}, {\(-6\), \(- .4\), 0}}, {{6, .4, 0}, {4, .4, 0}, \ \ {3, .4, 0}, {2, .45, .1}, {1, .6, .1}, \ \ {0, 1.3, \(- .5\)}, {\(-1\), 1.3, 0}, {\(-1.6\), 0, .5}, {\(-1\), \(-1.3\), 0}, {0, \(-1.3\), \(- .5\)}, {1, \(- .6\), .1}, {2, \(- .45\), \ .1}, {3, \(- .4\), 0}, {3.5, \(- .4\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(granny = {{{\(-4\), .5, 1}, {\(-3\), .5, 1}, {\(-2\), .5, .45}, {\(-1\), .5, 0}, {0, 1, \(-1\)}, {1, 1.1, 0}, {2, .5, 1}, {2, \(- .5\), \(-1\)}, {1, \(-1\), 0}, {0, \(-1\), 1}, {\(-1\), \(- .5\), 0}, {\(-2\), \(- .45\), \(-1\)}, {\(-3\), \(- .5\), \(-1\)}, \ {\(-4.5\), \(- .5\), \(-1\)}}, {{4, .5, \(-1\)}, \ \ {3, .5, \(-1\)}, {2, \ .5, \(- .45\)}, {1, .5, 0}, \ {0, 1, 1}, \[IndentingNewLine]{\(-1\), 1.1, 0}, {\(-2\), .5, \(-1\)}, {\(-2\), \(- .5\), 1}, {\(-1\), \(-1\), 0}, {0, \(-1\), \(-1\)}, {1, \(- .5\), 0}, {2, \(- .45\), 1}, {3, \(- .5\), 1}, {4.5, \(- .5\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(griefs = (*Granny\ with\ thiefs\ reversed\ pull*) {{{\(-3.5\), .4, 0}, {\(-3\), .4, 0}, {\(-2\), .45, \(- .1\)}, {\(-1\), .6, \(- .1\)}, {0, 1.3, .5 (*5*) }, {1, 1.3, 0}, {1.6, .5, \(- .5\)}, {1.6, \(- .7\), .5}, {1, \(-1.5\), \ .6}, {0, \(-1.5\), \(- .5\) (*10*) }, {\(-1\), \(- .8\), \(- .1\)}, {\(-2\), \ \(- .65\), \(- .1\)}, {\(-3\), \(- .6\), 0}, {\(-4\), \(- .6\), 0}, {\(-6\), \(- .6\), 0}}, {{6, .4, 0}, {4, .4, 0}, \ \ {3, .4, 0}, {2, .45, .1}, {1, .6, .1}, \ \ {0, 1.3, \(- .5\) (*5*) }, {\(-1\), 1.3, 0}, {\(-1.6\), .5, .5}, {\(-1.6\), \(- .7\), \(- .5\)}, {\(-1\ \), \(-1.5\), 0}, {0, \(-1.5\), .5 (*10*) }, {1, \(- .8\), .1}, {2, \(- .65\ \), .1}, {3, \(- .6\), 0}, {3.5, \(- .6\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(weavers (*A1418*) = {{{\(-3\), 0, 0}, {\(-2\), 0, 0}, {\(-1\), 0, 0}, {0, \(- .2\), \(- .1\)}, { .8, \(- .7\), \(- .3\)}, {1.2, \ \(- .2\), .5}, { .8, .4, \(- .1\)}, { .1, 0, .2}, {0, \(-1\), \(- .3\)}, {0, \(-1.5\), \(- .6\)}}, {{3, 0, 0}, {2, 0, 0}, {1, .1, 0}, { .1, .4, .5\ \ }, {\(- .4\), 0, \(- .5\)}, {0, \(- .6\), .5}, {1, \(- .4\), 0}, {2, \(- .4\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(hunters = (*A1425a\ Hunter' s\ bend*) \[IndentingNewLine]{{{\(-3\), .45, .25}, {\(-2.5\), \ .4, .25}, {\(-2\), .35, .25}, {\(-1.6\), .3, .25}, {\(-1\), .25, .27}, \ {0, .24, .5}, { .7, 0, \(- .4\)}, { .6, \(- .8\), \(- .6\)}, {\(- .6\), \(- .7\), \ \(- .4\)}, {\(- .7\), \(- .4\), .8}, {\(- .5\), .65, .8}, {\(- .3\), .1, \ \(- .5\)}, {\(- .2\), \(-1\), \(- .1\)}, {\(- .16\), \(-1.5\), 0}, {\(- .15\), \(-2\), 0}}, {{3, \(- .45\), .25}, {2.5, \(- .4\), .25}, {2, \(- \ .35\), .25}, {1.6, \(- .3\), .25}, {1, \(- .25\), .27}, {0, \(- .24\), \ .5}, {\(- .7\), 0, \(- .4\)}, {\(- .6\), .8, \(- .6\)}, { .6, .7, \(- .4\)}, \ { .7, .4, .8}, { .5, \(- .65\), .8}, { .3, .1, \(- .5\)}, { .2, 1, \(- .1\)}, { .16, 1.5, 0}, { .15, 2, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(sheetbend (*A1431*) = {{{\(-3\), 0, 0}, {\(-2\), 0, 0}, {\(-1\), \(- .15\), \(- .1\)}, {0, \(- .7\), \(- .6\)}, { \ .9, \(-1.2\), \(- .3\)}, {1.7, \(- .8\), .5}, {1.7, .3, .5}, { .9, .6, 0}, { .2, 0, 0}, { .1, \(-1\), \(- .1\)}, { .1, \(-2\), \(- .3\)}}, {{4, 0, 0}, {3, 0, 0}, {2, .02, 0}, { .8, .1, .5}, {\(- .3\), .5, \(- .1\)}, {\(-1.2\), \(- \ .1\), \(- .7\)}, {\(- .5\), \(-1\), \(- .1\)}, { .8, \(- .7\), .5}, {2, \(- \ .6\), 0}, {3, \(- .6\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(tuckedSheetBend (*A1436*) = {{{6, 0, 0}, {4, 0, 0}, {3, 0, 0}, {1.75, \(- .5\), 0}, {1.4, .5, 1}, {2.25, 1, 0}, {3, 1, 0}, {4.5, 1, 0}}, \[IndentingNewLine]{{\(-1\), 0, 0}, {1, 0, 0}, {2.25, 0, .15}, {2.75, 1.5, .5}, {3.5, .5, \(- .75\)}, {3.25, \(- .5\), .25}, {2, \ \(- .5\), 1.25}, {2, .5, .25}, {3, .5, .25}, {4.5, .5, \ .25}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(whatnot (*A1409*) = {{{\(-6\), 0, .3}, {\(-5\), 0, .5}, {\(-4\), 0, .8}, {\(-2\), 0, \(-1\)}, {\(-0.5\), \(- .5\), \(-1\)}, {1, \(-1\), \(-1\)}, \ {2, \(-1\), \(-1\)}, {3, 0, 1}, {1.8, .9, \(- .5\)}, {0, .7, \(-1\)}, {\(-1\), 0, 1}, {\(-2\), \(-1\), \(-1\)}, {\(-3\), \(-2\), \(-1\)}}, \ \[IndentingNewLine]{{6, 0, \(- .3\)}, {5, 0, \(- .5\)}, {4, 0, \(- .8\)}, {2, 0, 1}, { .5, \(- .5\), 1}, {\(-1\), \(-1\), 1}, {\(-2\), \(-1\), 1}, {\(-3\), 0, \(-1\)}, {\(-1.8\), .9, \(- .5\)}, {0, .7, 1}, {1, 0, \(-1\)}, {2, \(-1\), 1}, {3, \(-2\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(ringKnot1 (*A1412*) = {{{\(-5\), 1, 0}, {\(-4\), 1, 0}, {\(-2\), 1, 0}, {\(- .8\), 1.2, .1}, { .8, 2.5, .2}, {1.9, 1.75, \(- .5\)}, {1.75, .25, \(-1\)}, {0, 0, 0}, {\(-1.1\), .4, .5}, {\(-1.7\), 1.5, .75}, {\(-1.2\), 2.5, \(- .5\)}, { .2, 1.8, \(- .75\)}, {1.2, .5, .5}, {1.7, \(- .5\), 1.5}, {2, \(-1\), 2.5}}\[IndentingNewLine], {{6, 1, 0}, {5, 1, 0}, {3, 1, 0}, {1.8, 1.2, \(- .1\)}, { .2, 2.5, \(- .2\)}, {\(- .9\), 1.75, .5}, {\(- .25\), .25, 1}, {1, 0, .2}, {2.1, .4, \(- .5\)}, {2.5, 1.5, \(- .5\)}, {2, 2.5, .25}, { .8, 1.8, .75}, {\(- .2\), .5, \(- .5\)}, {\(- .7\), \(- .5\), \ \(-1.5\)}, {\(-1\), \(-1\), \(-2.5\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(binderKnot (*A1410*) = {{{\(-3\), 0, 0}, {\(-2\), 0, 0}, {\(-1\), \(- .02\), \(- .7\)}, {0, \(- .1\), \(-1.6\)}, { \ .8, \(- .2\), \(-1\)}, {1, \(- .7\), \(- .6\)}, { .4, \(-1.2\), \(- .4\)}, \ {\(- .4\), \(-1.2\), \(- .8\)}, {\(-1\), \(- .7\), \(-1\)}, {\(-1.5\), .2, \ \(-1.2\)}, \[IndentingNewLine]{\(-1.2\), 1.7, \(-1.5\)}, {\(- .3\), 1.8, \(-1.1\)}, { .3, .8, \(- .7\)}, { .4, \(-1\), \(- .7\)}, \ { .4, \(-2\), \(- .7\)}}, \[IndentingNewLine]{{3, 0, 0}, {2, 0, 0}, { .2, 0, \(- .1\)}, {\(- .5\), .4, \(- .5\)}, {\(- .7\), 1.1, \(-1\)}, { .2, 1.5, \(-1\)}, {1, .5, \(- .25\)}, { .5, \(- .75\), \(- .1\)}, \ {\(-1\), \(- .8\), \(- .2\)}, \[IndentingNewLine]{\(-1.6\), 0, \(- .5\)}, {\(-1.2\), 1.4, \(- .8\)}, {\(- .4\), 1, \(- .9\)}, {\(- .2\), 0, \(- .97\)}, {\(- .2\), \(-1\), \(-1\)}, {\(- .2\), \(-2\), \ \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(waterKnotx (*\ \(-c\), \ A1022*) = {{{\(-3\), 0, 0}, {\(-1\), 0, 0}, {0, 0, .1}, {1, \(- .1\), .3}, {1.7, \(- .2\), 1}, \[IndentingNewLine]{2.1, .6, .3}, {1.5, 1, \(-1\)}, {1, .1, \(-1\)}, { .9, \(- .8\), .8}, {1, \(- \ .2\), 1.2}, {1.4, .4, 0}, {2, .6, \(- .8\)}, {3, .6, \(- .8\)}, {3.5, .6, \(- \ .8\)}}, \[IndentingNewLine]{{4.5, 0, 0}, {2.5, 0, 0}, {1.5, 0, \(- .1\)}, { .5, .1, \(- .3\)}, {\(- .2\), .2, \(-1\)}, \ {\(- .6\), \(- .6\), \(- .3\)}, {0, \(-1\), 1}, { .5, \(- .1\), 1}, { .6, .8, \(- .8\)}, { .5, .2, \(-1.2\)}, { .1, \(- .4\), 0}, {\(- .5\), \(- .6\), .8}, {\(-1.5\), \(- .7\), .8}, {\(-2\ \), \(- .7\), .8}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(waterKnot (*\ C\ A496, \ A1414*) = {{{ .5, .2, 0}, {0, .2, \(- .1\)}, {\(- .9\), .1, \(- .3\)}, {\(-1.6\), 0, .8}, \[IndentingNewLine]{\(-1.9\), .6, .3}, {\(-1.4\), 1, \(-1\)}, {\(-1\), .1, \(-1\)}, {\(- .9\), \(- .4\), .8}, {\ \(-1\), \(- .2\), 1.2}, {\(-1.4\), .5, 0}, {\(-2\), .6, \(- .8\)}, {\(-3\), .6, \(- .8\)}, {\(-4\), \ .6, \(- .8\)}}, \[IndentingNewLine]{{1.3, .6, 0}, { .3, .6, 0}, {\(- .7\), .45, \(- .2\)}, {\(-1.9\), \(- .1\), \(- .3\)}, \ {\(-2.4\), \(- .4\), .8}, \[IndentingNewLine]{\(-2.4\), .6, .3}, \ {\(-1.9\), 1, \(-1\)}, {\(-1.7\), .2, \(-1\)}, {\(-1.6\), \(- .4\), .8}, \ {\(-2\), \(- .2\), 1.2}, {\(-2.3\), .0, 0}, {\(-2.9\), .1, \(- .7\)}, {\(-3.7\), .1, \(- \ .8\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(zeppelinKnot (*"\"\ Not\ in\ \(\(Ashley\)\(.\)\)\ *) = \ {{{\(-5\), 0, 0}, {\(-4\), 0, 0}, {\(-3\), 0, 0}, {\(-1\), .3, 0}, \[IndentingNewLine]{1.5, 1.1, 1}, {1.6, 2, 1.5}, {\(- .5\), 2.2, 2}, \[IndentingNewLine]{\(-2\), 1.5, .5}, {\(-2.3\), \(- .5\), \(-1\)}, {\(-2\), \(-2\), 0}, {\(- .6\), \(-2\), .7}, {\(- .7\), 1, 1}, {\(- .8\), 4, 1}}\[IndentingNewLine], {{5, 0, 0}, {4, 0, 0}, {3, 0, 0}, {1, \(- .3\), 0}, {\(-1.5\), \(-1.1\), \(-1\)}, {\(-1.6\), \(-2\), 1.5}, { .5, \(-2.2\), 2}, {2, \(-1.5\), .5}, {2.3, .5, \(-1\)}, {2, 2, 0}, { .6, 2, .7}, { .7, \(-1\), 1}, { .9, \(-4\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[{ \(\(gord = {{{\(-4\), 3/4, 0}, {\(-2\), 3/4, 0}, {0, 1/2, \(-1\)/2}, {1, 0, \(-1\)}, {1, \(-1\), \(-3\)/ 4}, \[IndentingNewLine]{0, \(-5\)/4, 1}, {\(-1\)/2, 0, 0}, {0, 5/4, \(-1\)}, {1, 1, 3/4}, {1, 0, 1}, \[IndentingNewLine]{0, \(-5\)/8, 1/2}, {\(-2\), \(-3\)/4, 0}, {\(-3\), \(-3\)/4, 0}}, {{4, 3/4, 0}, {2, 3/4, 0}, {0, 1/2, 1/2}, {\(-1\), 0, 1}, {\(-1\), \(-1\), 3/4}, \[IndentingNewLine]{0, \(-5\)/4, \(-1\)}, {1/2, 0, 0}, {0, 5/4, 1}, {\(-1\), 1, \(-3\)/4}, {\(-1\), 0, \(-1\)}, \[IndentingNewLine]{0, \(-5\)/8, \(-1\)/ 2}, {2, \(-3\)/4, 0}, {3, \(-3\)/4, 0}}};\) (*My\ Gordian\ knot . \ Very\ difficult\ to\ untie\ when\ it\ has\ been\ pulled\ tight\ \ on\ all\ four\ ends . \ bGord\ is\ 2 - links\ braid\ form*) \), "\n", \(\(bGord = {3, \(-1\), 2, 3, \(-1\), 2, 3, \(-1\), 2, 3, \(-1\), 2, 3, \(-1\), 2, 3, \(-1\), 2};\)\)}], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Show[curvs[ringBraid[bGord], chordno \[Rule] 1], V003, BF];\)\)], "Input"], Cell[BoxData[ \(\(rL = {{{\(-3\), 0, 0}, {\(-2\), 0, 0}, {\(-1\), .2, 0}, {0, .4, \(- .2\)}, {0, .5, \(- .8\)}, {\(-1\), .5, \(- \ .8\)}, {\(-1.7\), .5, 0}, {\(-1.25\), \(- .2\), .5}, {\(- .2\), \(- .7\), 0}, {0, 0, \(- .5\)}, {\(-1\), 1.5, 0}}, \[IndentingNewLine]{{2, 0, 0}, {1, 0, 0}, {0, \(- .2\), 0}, {\(-1\), \(- .4\), \(- .2\)}, {\(-1\), \(- .5\), \(- .7\)}, \ {0, \(- .5\), \(- .8\)}, { .7, \(- .5\), 0}, { .25, .2, .5}, {\(- .8\), .7, 0}, {\(-1\), 0, \(- .5\)}, {0, \(-1.5\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(CaR = {{{\(-4\), 0, 0}, {\(-2\), 0, .1}, {\(- .5\), .3, .2}, { .8, .3, 0}, { .2, \(- .6\), \(-1\)}, {\(- .8\), \(- .9\), \(- .4\)}, \ {\(-1.4\), 0, .7}, {\(- .8\), 1, 0}, {\(- .3\), 0, \(- .3\)}, {0, \(-1\), \(- .5\)}, {0, \(-2\), \(- .6\)}}, \ \[IndentingNewLine]{{4, 0, 0}, {2, 0, .1}, { .5, \(- .3\), .2}, {\(- .8\), \(- .3\), 0}, {\(- .2\), .6, \(-1\)}, { .8, .9, \(- .4\)}, {1.4, 0, .7}, { .8, \(-1\), 0}, { .3, 0, \(- .3\)}, {0, 1, \(- .5\)}, {0, 2, \(- .6\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(MW2 = (*2 - strand\ Mathew\ Walker\ CaC\ A776*) {{{\(-3\), .3, 0}, {\(-2\), .3, .1}, {\(- .2\), .25, .2}, { .5, \(- .1\), \ .5}, { .3, \(- .8\), .1 (*5*) }, {0, 0, \(- .7\)}, {\(- .3\), .7, \(- .3\)}, {\(- .5\), .3, .6}, \ { .2, \(- .25\), .2 (*9*) }, {1, \(- .3\), 0}, {1.5, \(- .3\), 0}}, \[IndentingNewLine]{{3, .3, 0}, {2, .3, \(- .1\)}, { .2, .25, \(- .2\)}, {\(- .5\), \(- \ .1\), \(- .5\)}, {\(- .3\), \(- .8\), .1 (*5*) }, {0, 0, .7}, { .3, .7, .3}, { .5, .3, \(- .6\)}, { .2, \(- \ .25\), \(- .2\) (*9*) }, {\(-1\), \(- .3\), 0}, {\(-1.5\), \(- .3\), 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(lBr = (*A1425*) {{{\(-3\), 1, 0}, {\(-2\), .95, .05}, {\(-1\), .85, .15}, {0, .7, .25}, \ { .9, .4, .35 (*5*) }, {1.2, 0, .2}, {1, \(- .7\), \(- .4\)}, {0, \(- .9\), \(- .7\)}, {\(- \ .5\), \(- .6\), \(- .5\)}, {\(- .8\), 0, 0 (*10*) }, {\(- .5\), 1, .7}, {\(- .3\), 1.5, \(- .6\)}, {\(- .1\), 0, \(- .4\)}, { .2, \(-1\), \(- .1\)}, { .5, \(-2\), .1}}, \ \[IndentingNewLine]{{3, 1, 0}, {2, .95, \(- .05\)}, {1, .85, \(- .15\)}, \ \[IndentingNewLine]{0, .7, \(- .25\)}, {\(- .9\), .4, \(- .35\) (*5*) }, \ {\(-1.2\), 0, \(- .2\)}, {\(-1\), \(- .7\), .4}, {0, \(- .9\), .7}, { \ .5, \(- .6\), .5}, { .8, 0, 0 (*10*) }, { .5, 1, \(- .7\)}, { .3, 1.5, .6}, { .1, 0, .4}, {\(- .2\), \(-1\), .1}, {\(- .5\), \(-2\), \(- \ .1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["5.3. Braids, Hitches, Weaves..", "Subsection"], Cell[BoxData[ \(\(braid4a = {{{0, 0, 0}, {1, .05, 0}, {2, .5, \(-1\)/2}, {3, 1, 0}, {4, 1.5, 1/2}, {5, 1.95, 0}, {6, 2, 0}, {0, 1, 0}, {1, .95, 0}, {2, .5, \ 1/2}, {3, .05, 0}, {4, 0, 0}, {5, 0, 0}, {6, 0, 0}}, \[IndentingNewLine]{{0, 2, 0}, {1, 2.05, 0}, {2, 2.5, \ 1/2}, {3, 2.95, 0}, {4, 3, 0}, {5, 3, 0}, {6, 3, 0}}, {{0, 3, 0}, {1, 2.95, 0}, {2, 2.5, \(-\ 1\)/2}, {3, 2, \(-\ 1\)/2}, {4, 1.5, \(-\ 1\)/2}, {5, 1.05, 0}, {6, 1, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(braid4b = {{{0, 0, 0}, {1, .05, 0}, {2, .5, \(-1\)/2}, {3, 1, 0}, {4, 1.5, 1/2}, {5, 1.95, 0}, {6, 2, 0}, {7, 2, 0}}, \[IndentingNewLine]{{0, 1, 0}, {1, .95, 0}, {2, .5, \ 1/2}, {3, 0, 0}, {4, 0, 0}, {5, .5, \(-1\)/2}, {6, 1, 0}, {7, 1, 0}}, \[IndentingNewLine]{{0, 2, 0}, {1, 2.05, 0}, {2, 2.5, \ 1/2}, {3, 2.95, 0}, {4, 3, 0}, {5, 3, 0}, {6, 3, 0}, {7, 3, 0}}, \[IndentingNewLine]{{0, 3, 0}, {1, 3, 0}, {2, 2.8, \(-\ 1\)/2}, {3, 1.8, \(-\ 1\)/2}, {4, 1, \(-\ .4\)}, {5, .1, .6}, {6, 0, .2}, {7, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(weave22 = {{{1, 0, 0}, {1, 1, 0.3}, {1, 2, \(-0.3\)}, {1, 3, 0}}, {{2, 0, 0}, {2, 1, \(-0.3\)}, {2, 2, 0.3}, {2, 3, 0}}, {{0, 1, 0}, {1, 1, \(-0.3\)}, {2, 1, 0.3}, {3, 1, 0}}, {{0, 2, 0}, {1, 2, 0.3}, {2, 2, \(-0.3\)}, {3, 2, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(weave436 = {\[IndentingNewLine]{{1, 0, 0}, {1, 1, 0.3}, {1, 2, \(-0.3\)}, {1, 3, .3}, {1, 4, \(- .3\)}}, \[IndentingNewLine]{{2, 0, 0}, {2, 1, \(-0.3\)}, {2, 2, 0.3}, {2, 3, \(- .3\)}, {2, 4, .3}}, \[IndentingNewLine]{{3, 0, 0}, {3, 1, 0.3}, {3, 2, \(-0.3\)}, {3, 3, .3}, {3, 4, \(-0.3\)}}, \[IndentingNewLine]{{4, 0, 0}, {4, 1, \(-0.3\)}, {4, 2, 0.3}, {4, 3, \(- .3\)}, {4, 4, 0.3}}, \[IndentingNewLine]\[IndentingNewLine]{{0, 1, 0}, {1, 1, \(-0.3\)}, {2, 1, 0.3}, {3, 1, \(- .3\)}, {4, 1, .3}, {5, 1, \(-0.3\)}}, {{0, 2, 0}, {1, 2, 0.3}, {2, 2, \(-0.3\)}, {3, 2, .3}, {4, 2, \(- .3\)}, {5, 2, 0.3}}, {{0, 3, 0}, {1, 3, \(- .3\)}, {2, 3, .3}, {3, 3, \(- .3\)}, {4, 3, .3}, {5, 3, \(- .3\)}}, \[IndentingNewLine]rad \[Rule] .1, {{0, 2, 0}, {2, 4, 0}}, rad \[Rule] .1, {{0, 1, 0}, {3, 4, 0}}, rad \[Rule] .1, {{0, 0, 0}, {4, 4, 0}}, rad \[Rule] .1, {{1, 0, 0}, {5, 4, 0}}, rad \[Rule] .1, {{2, 0, 0}, {5, 3, 0}}, rad \[Rule] .1, {{3, 0, 0}, {5, 2, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(weave77 = \[IndentingNewLine]{{{1, 0, \(- .3\)}, {1, 1, 0.3}, {1, 2, \(- .3\)}, {1, 3, .3}, {1, 4, \(- .3\)}, {1, 5, .3}, \ \ {1, 6, \(- .3\)}, {1, 7, .3}, \ \ {1, 8, \(- .3\)}}, \[IndentingNewLine]{{2, 0, .3}, \ \ {2, 1, \(- .3\)}, {2, 2, .3}, \ \ {2, 3, \(- .3\)}, {2, 4, .3}, \ \ {2, 5, \(- .3\)}, {2, 6, .3}, \ \ {2, 7, \(- .3\)}, {2, 8, .3}}, \[IndentingNewLine]{{3, 0, \(- .3\)}, {3, 1, .3}, \ \ {3, 2, \(- .3\)}, {3, 3, .3}, {3, 4, \(- .3\)}, {3, 5, .3}, \ \ {3, 6, \(- .3\)}, {3, 7, .3}, \ \ {3, 8, \(- .3\)}}, \[IndentingNewLine]{{4, 0, .3}, \ \ {4, 1, \(- .3\)}, {4, 2, .3}, \ \ {4, 3, \(- .3\)}, {4, 4, .3}, \ \ {4, 5, \(- .3\)}, {4, 6, .3}, \ \ {4, 7, \(- .3\)}, {4, 8, .3}}, \[IndentingNewLine]{{5, 0, \(- .3\)}, {5, 1, .3}, \ \ {5, 2, \(- .3\)}, {5, 3, .3}, {5, 4, \(- .3\)}, {5, 5, .3}, \ \ {5, 6, \(- .3\)}, {5, 7, .3}, \ \ {5, 8, \(- .3\)}}, \[IndentingNewLine]{{6, 0, .3}, \ \ {6, 1, \(- .3\)}, {6, 2, .3}, \ \ {6, 3, \(- .3\)}, {6, 4, .3}, \ \ {6, 5, \(- .3\)}, {6, 6, .3}, \ \ {6, 7, \(- .3\)}, {6, 8, .3}}, \[IndentingNewLine]{{7, 0, \(- .3\)}, {7, 1, .3}, \ \ {7, 2, \(- .3\)}, {7, 3, .3}, {7, 4, \(- .3\)}, {7, 5, .3}, \ \ {7, 6, \(- .3\)}, {7, 7, .3}, \ \ {7, 8, \(- .3\)}}, \[IndentingNewLine]\[IndentingNewLine]{{0, 1, .3}, {1, 1, \(- .3\)}, {2, 1, .3}, {3, 1, \(- .3\)}, {4, 1, .3}, {5, 1, \(- .3\)}, {6, 1, .3}, {7, 1, \(- .3\)}, {8, 1, .3}}, \[IndentingNewLine]{{0, 2, \(- .3\)}, {1, 2, .3}, {2, 2, \(- .3\)}, {3, 2, .3}, {4, 2, \(- .3\)}, {5, 2, .3}, {6, 2, \(- .3\)}, {7, 2, .3}, {8, 2, \(- .3\)}}, \[IndentingNewLine]{{0, 3, .3}, {1, 3, \(- .3\)}, {2, 3, .3}, {3, 3, \(- .3\)}, {4, 3, .3}, {5, 3, \(- .3\)}, {6, 3, .3}, {7, 3, \(- .3\)}, {8, 3, .3}}, \[IndentingNewLine]{{0, 4, \(- .3\)}, {1, 4, .3}, {2, 4, \(- .3\)}, {3, 4, .3}, {4, 4, \(- .3\)}, {5, 4, .3}, {6, 4, \(- .3\)}, {7, 4, .3}, {8, 4, \(- .3\)}}, \[IndentingNewLine]{{0, 5, .3}, {1, 5, \(- .3\)}, {2, 5, .3}, {3, 5, \(- .3\)}, {4, 5, .3}, {5, 5, \(- .3\)}, {6, 5, .3}, {7, 5, \(- .3\)}, {8, 5, .3}}, \[IndentingNewLine]{{0, 6, \(- .3\)}, {1, 6, .3}, {2, 6, \(- .3\)}, {3, 6, .3}, {4, 6, \(- .3\)}, {5, 6, .3}, {6, 6, \(- .3\)}, {7, 6, .3}, {8, 6, \(- .3\)}}, \[IndentingNewLine]{{0, 7, .3}, {1, 7, \(- .3\)}, {2, 7, .3}, {3, 7, \(- .3\)}, {4, 7, .3}, {5, 7, \(- .3\)}, {6, 7, .3}, {7, 7, \(- .3\)}, {8, 7, .3}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(weave77a = \[IndentingNewLine]{{{1, 0, \(- .3\)}, {1, 1, .3}, {1, 2, .3}, {1, 3, .3}, {1, 4, \(- .3\)}, {1, 5, \(- .3\)}, \ \ {1, 6, \(- .3\)}, {1, 7, .3}, \ \ {1, 8, .3}}, \[IndentingNewLine]{{2, 0, .3}, \ \ {2, 1, .3}, {2, 2, .3}, \ \ {2, 3, \(- .3\)}, {2, 4, \(- .3\)}, \ \ {2, 5, \(- .3\)}, {2, 6, .3}, \ {2, 7, .3}, {2, 8, .3}}, \[IndentingNewLine]{{3, 0, .3}, \ \ {3, 1, .3}, \ \ {3, 2, \(- .3\)}, {3, 3, \(- .3\)}, {3, 4, \(- .3\)}, {3, 5, .3}, \ \ {3, 6, .3}, {3, 7, .3}, \ \ {3, 8, \(- .3\)}}, \[IndentingNewLine]{{4, 0, .3}, \ \ {4, 1, \(- .3\)}, {4, 2, \(- .3\)}, \ \ {4, 3, \(- .3\)}, {4, 4, .3}, \ {4, 5, .3}, {4, 6, .3}, \ \ {4, 7, \(- .3\)}, {4, 8, \(- .3\)}}, \[IndentingNewLine]{{5, 0, \(- .3\)}, {5, 1, \(- .3\)}, \ \ {5, 2, \(- .3\)}, {5, 3, .3}, {5, 4, .3}, {5, 5, .3}, \ \ {5, 6, \(- .3\)}, {5, 7, \(- .3\)}, \ \ {5, 8, \(- .3\)}}, \[IndentingNewLine]{{6, 0, \(- .3\)}, \ {6, 1, \(- .3\)}, {6, 2, .3}, \ \ {6, 3, .3}, {6, 4, .3}, \ \ {6, 5, \(- .3\)}, {6, 6, \(- .3\)}, \ {6, 7, \(- .3\)}, {6, 8, .3}}, \[IndentingNewLine]{{7, 0, \(- .3\)}, {7, 1, .3}, \ \ {7, 2, .3}, {7, 3, .3}, {7, 4, \(- .3\)}, {7, 5, \(- .3\)}, \ \ {7, 6, \(- .3\)}, {7, 7, .3}, \ \ {7, 8, .3}}, \[IndentingNewLine]\[IndentingNewLine]{{0, 1, .3}, \ \ {1, 1, \(- .3\)}, {2, 1, \(- .3\)}, {3, 1, \(- .3\)}, {4, 1, .3}, {5, 1, .3}, {6, 1, .3}, {7, 1, \(- .3\)}, {8, 1, \(- .3\)}}, \[IndentingNewLine]{{0, 2, \(- .3\)}, {1, 2, \(- .3\)}, {2, 2, \(- .3\)}, {3, 2, .3}, {4, 2, .3}, {5, 2, .3}, {6, 2, \(- .3\)}, {7, 2, \(- .3\)}, {8, 2, \(- .3\)}}, \[IndentingNewLine]{{0, 3, \(- .3\)}, {1, 3, \(- .3\)}, {2, 3, .3}, \ {3, 3, .3}, {4, 3, .3}, {5, 3, \(- .3\)}, {6, 3, \(- .3\)}, {7, 3, \(- .3\)}, {8, 3, .3}}, \[IndentingNewLine]{{0, 4, \(- .3\)}, {1, 4, .3}, {2, 4, .3}, {3, 4, .3}, {4, 4, \(- .3\)}, {5, 4, \(- .3\)}, {6, 4, \(- .3\)}, {7, 4, .3}, {8, 4, .3}}, \[IndentingNewLine]{{0, 5, .3}, {1, 5, .3}, \ \ {2, 5, .3}, {3, 5, \(- .3\)}, {4, 5, \(- .3\)}, {5, 5, \(- .3\)}, {6, 5, .3}, {7, 5, .3}, {8, 5, .3}}, \[IndentingNewLine]{{0, 6, .3}, {1, 6, .3}, \ \ {2, 6, \(- .3\)}, {3, 6, \(- .3\)}, {4, 6, \(- .3\)}, {5, 6, .3}, {6, 6, .3}, {7, 6, .3}, {8, 6, \(- .3\)}}, \[IndentingNewLine]{{0, 7, .3}, {1, 7, \(- .3\)}, {2, 7, \(- .3\)}, {3, 7, \(- .3\)}, {4, 7, .3}, {5, 7, .3}, {6, 7, .3}, {7, 7, \(- .3\)}, {8, 7, \(- .3\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(hitch1 = {rad \[Rule] 0.3, perimno \[Rule] 10, {{1, \(-1.5\), 0.1}, {1, 1.2, 0.1}}, rad \[Rule] 0.6, perimno \[Rule] 20, {{\(-0.3\), \(-1\), 0.1}, {\(-0.3\), 1.3, 0.1}}, rad \[Rule] 0.15, {{\(-2\), 0, 0.9}, {\(-1\), 0, 0.9}, {0, 0.2, 0.85}, {1, 0.5, 0.65}, {1.5, 0.1, 0.1}, {0.8, \(-0\), \(-0.6\)}, {\(-0.42\), 0.3, \(-0.7\)}, {\(-1.1\), 0.45, .1}, {\(-0.4\), 0.2, 1.1}, {0.31, 0, .9}, {0.54, 0, .1}, {1, 0.25, \(-0.4\)}, {1.5, 0.4, \(-0.4\)}, {2, 0.4, \(-0.4\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(hitch2 = (*clovehitch\ A1178*) \[IndentingNewLine]{rad \[Rule] .9, perimno \[Rule] 8, {{0, \(-1\), 0}, {0, 1, 0}}, \[IndentingNewLine]rad \[Rule] .07, \[IndentingNewLine]{{\ \(-2\), 0, 1}, {\(-1\), .02, 1}, {0, .1, 1}, { .6, .15, .75}, \[IndentingNewLine]{1, .2, 0}, { .75, .2, \(- .75\)}, {0, .2, \(-1\)}, {\(- .75\), .2, \ \(- .75\)}, {\(-1\), .18, \(- .1\)}, {\(- .9\), .18, .6}, \ \[IndentingNewLine]{0, 0, 1.3}, \[IndentingNewLine]{ .9, \(- .18\), .6}, {1, \(- .18\), \ \(- .1\)}, { .75, \(- .2\), \(- .75\)}, \[IndentingNewLine]{0, \(- .2\), \(-1\ \)}, {\(- .75\), \(- .2\), \(- .75\)}, {\(-1\), \(- .2\), 0}, {\(- .7\), \(- .15\), .7}, {0, \(- .1\), 1}, {1, \(- .02\), 1}, {2, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Prusik = (*A481\ Improvement\ on\ Magnus . \ Grips\ under\ load\ but\ esily\ moved*) {rad \[Rule] .75, perimno \[Rule] 12, {{0, 5, 0}, {0, 0, 0}}, \[IndentingNewLine]{{\(-1.5\), 5, .5}, {\(-1.2\), 3, .55}, {\(- .5\), 2.5, .85}, {\(- .1\), 2.45, 1}, { .65, 2.5, .7}, {1, 2.7, \(- .1\) (*6*) }, {0, 2.85, \(-1\)}, {\(-1\), 3, \(- .1\)}, {0, 3.15, 1}, {1, 3.3, \(- .1\) (*10*) }, {\ \ 0, 3.45, \(-1\)}, {\(- .75\), 3.5, \(- .5\)}, {\(-1\), 3.55, .1}, {\(-1\), 3.25, 1}, {\(-1.05\), 2.4, 1.1 (*16*) }, {\(-1.05\), 1.5, 1}, {\(-1\), 1, .8}, {\(- .8\), .9, \(- .3\)}, {0, .9, \(-1\)}, {1, 1.05, 0 (*21*) }, {0, 1.2, 1}, {\(-1\), 1.35, 0}, {0, 1.5, \(-1\)}, {1, 1.65, 0}, {0, 1.8, 1 (*26*) }, {\(-1\), 1.7, .7}, {\(-1.5\), 1, .6}, {\(-1.5\), .5, .6}, {\(-1.5\), 0, .6}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["I have omitted the post in later hitches.", "Text"], Cell[BoxData[ \(\(clovehitch = (*A1178*) \[IndentingNewLine]{{{\(-3\), .3, .1}, \ {\(-2\), .3, .1}, {\(-1\), .3, .05}, {0.7, .2, \(- .1\)}, {2, \(-5\)/ 8, \(-2\)}, {0, \(-3\)/4, \(-4\)}, {\(-2\), \(-5\)/ 8, \(-2\)}, {0, 0, .5}, {2, 3/8, \(-2\)}, {0, 3/4, \(-4\)}, {\(-2\), 3/8, \(-2\)}, {\(- .7\), \(- .2\), \(- .1\)}, {1, \(- .3\), \ .05}, {2, \(- .3\), .1}, {3, \(- .3\), .1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Magnus = (*A1736*) {rad \[Rule] .75, perimno \[Rule] 12, {{0, 4, 0}, {0, 0, 0}}, \[IndentingNewLine]{{\(-3\), 2, .5}, {\(-1.5\), 2, .55}, {\(- .5\), 2.1, .85}, {\(- .1\), 2.2, 1}, { .75, 2.25, .8}, {1, 2.3, \(- .1\) (*6*) }, {\(- .1\), 2.4, \(-1\)}, {\(- .75\), 2.5, \(- .5\)}, {\(-1\), 2.55, .1}, {\(-1\), 2.25, 1}, {\(-1.05\), 2, 1.1 (*11*) }, {\(-1.05\), 1.5, 1}, {\(-1\), 1, .8}, {\(- .8\), .9, \(- .3\)}, {0, .9, \(-1\)}, {1, 1.05, 0 (*15*) }, {0, 1.2, 1}, {\(-1\), 1.35, 0}, {0, 1.5, \(-1\)}, {1, 1.65, 0}, {0, 1.8, 1}, {\(-1\), 1.7, .7 (*21*) }, {\(-1.5\), 1, .6}, {\(-1.5\), .5, .6}, {\(-1.5\), 0, .6}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["\<\ The following singlepass towing hitch is my improvement (?) on A1731. A long \ loop is passed over the load and brought forward. The free end is brought out \ through the loop, over the tow-rope, and back under the loop.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(singlepass = {{{\(-5\), \(- .25\), 0}, {\(-3\), \(- .25\), 0}, {\(-2\), \(- .1\), 0}, {\(-1\), .1, 0}, {1, .1, 0}, {2, \(-3\)/2, 0}, {0, \(-3\), .1}, {\(-1.3\), \(-2\), .3}, {\(-1.5\), \ \(-1.1\), .15}, {\(-1.5\), \(-1.1\), \(- .5\) (*10*) }, {\(-1.3\), \(-1.7\), \ \(- .8\)}, {0, \(-3\), \(- .9\)}, {2, \(-1\), \(-1\)}, {0, .1, \(-1\)}, \ {\(-1.7\), \(-1.9\), 0}, {\(-2.1\), 0, .5 (*16*) }, {\(-1.5\), .3, \(- .5\)}, {\(-1.35\), \(- \ .6\), 0}, {\(-1.3\), \(- .75\), 1}, {\(-1.3\), \(- .6\), 2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["\<\ The Constrictor (Ashley c1920, though [10] says it is ancient!). Make an \ upward loop, move the upper left part down, twisting it towards you, fold to \ makea twin tunnel, slip over the post.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\(\ \ \)\(constrictor = (*\(A1249\)\(.\)\ \ *) \[IndentingNewLine]{{{\(-3\), 2, 0}, {\(-2\), 2, .02}, {\(-1\), 2, .05}, { .1, 2, .2}, { .5, 2.2, \(- .2\) (*5*) }, {1, 1.75, \(- .38\)}, {2, 0, \(- .4\)}, {1, \(-1.6\), \(- .4\)}, {0, \(-2\), \(- .4\)}, {\ \(-1\), \(-1.6\), \(- .4\) (*10*) }, {\(-2\), 0, \(- .39\)}, {\(-1\), 1.75, \(- .37\)}, {\(- .3\), 2.3, \(- .2\)}, {0, 2.5, 0}, { .3, 2.33, .2 (*15*) }, {1, 1.7, .37}, {2, 0, .39}, {1, \(-1.6\), .4}, {0, \(-2\), .4}, {\(-1\), \(-1.6\ \), .4 (*20*) }, {\(-2\), 0, .4}, {\(-1\), 1.6, .38}, {\(- .5\), 2.2, .2}, {0, 2, \(- .2\)}, {1, 2, \(- .05\) (*25*) }, {2, 2, \(- .02\)}, {3, 2, 0}}};\)\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["\<\ The Boa (Collingwood 1996[10]) is a 4-loop constrictor that is tied in the \ same way, but starts with two loops.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(\(\ \)\(boa = {{{\(-3\), .1, .1}, {\(-2\), 0, .1}, {\(-1\), \(- .1\), .05}, {0.7, \(- .4\), \(- .1\)}, \ {2, \(-5\)/ 8, \(-2\)}, {0, \(- .8\), \(-4\)}, {\(-2\), \(- .8\), \ \(-2\)}, {0, .3, 1}, {2, 3/2, \(-2\)}, {0, 1.7, \(-4\) (*10*) }, {\(-2\), 1.4, \(-2\)}, {0, 0, 1/2}, {2, \(-1.3\), \(-2\)}, {0, \(-1.7\), \(-4\)}, {\(-2\), \ \(-1.4\), \(-2\) (*15*) }, {0, \(- .3\), 1}, {2, .75, \(-2\)}, {0, .8, \(-4\)}, {\(-2\), .8, \(-2\)}, \ {\(- .7\), .4, \(- .1\)}, {1, .1, .05}, {2, 0, .1}, {3, \(- .1\), .1}}};\)\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 5.4. Dowker Notation test cases (NB uses nodeList, not lineList).\ \>", "Subsection"], Cell[BoxData[ \(\(Adamsfig28 = {{{\(-1\), 4}, {2, 5}, {\(-3\), 6}, {4, 1}, {\(-5\), 2}, {6, 3}, {\(-7\), 10}, {8, 11}, {\(-9\), 12}, {10, 7}, {\(-11\), 8}, {12, 9}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Adamsfig29 = {{{\(-1\), 8}, {2, 7}, {\(-3\), 6}, {4, 9}, {\(-5\), 10}, {6, 3}, {\(-7\), 2}, {8, 1}, {\(-9\), 4}, {10, 5}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Adamsfig212 = {{{\(-1\), 6}, {2, 9}, {3, 14}, {\(-4\), 11}, {\(-5\), 16}, {6, 1}, {7, 12}, {\(-8\), 13}, {\(-9\), 2}, {10, 15}, {11, 4}, {\(-12\), 7}, {13, 8}, {\(-14\), 3}, {\(-15\), 10}, {16, 5}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Adamsfig553 = (*k08020*) \[IndentingNewLine]{{{\(-1\), 12}, {\(-2\), 7}, {3, 14}, {4, 9}, {\(-5\), 10}, {\(-6\), 13}, {7, 2}, {8, 15}, {\(-9\), 4}, {10, 5}, {\(-11\), 16}, {12, 1}, {13, 6}, {\(-14\), 3}, {\(-15\), 8}, {16, 11}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Adamsfig553a = (*k08023*) \[IndentingNewLine]{{{\(-1\), 12}, {2, 7}, {3, 14}, {\(-4\), 9}, {5, 10}, {6, 13}, {\(-7\), 2}, {\(-8\), 15}, {9, 4}, {\(-10\), 5}, {\(-11\), 16}, {12, 1}, {\(-13\), 6}, {\(-14\), 3}, {15, 8}, {16, 11}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[{ \(dowth[ Adamsfig28]\[IndentingNewLine] (*ShowKnotfromPdata[KnotbyDT[%]]; \ FAILS*) \), "\[IndentingNewLine]", \(dowth[\(-Adamsfig29\)]\), "\[IndentingNewLine]", \(\(ShowKnotfromPdata[KnotbyDT[%]];\)\), "\[IndentingNewLine]", \(dowth[Adamsfig212]\), "\[IndentingNewLine]", \(\(ShowKnotfromPdata[KnotbyDT[%]];\)\), "\[IndentingNewLine]", \(dowth[Adamsfig553]\), "\[IndentingNewLine]", \(\(ShowKnotfromPdata[KnotbyDT[%]];\)\), "\[IndentingNewLine]", \(dowth[Adamsfig553a]\), "\[IndentingNewLine]", \(\(ShowKnotfromPdata[KnotbyDT[%]];\)\)}], "Input", FontSize->9], Cell[BoxData[ \(\(dowtest = (*\(This\ &\)\ dowtest2\ are\ linelists*) {{{1, \(-2\), 1}, {\(-1\), \(-1\), \(-1\)}, {2, 1, 1}, {2, \(-1\), \(-1\)}, {\(-1\), 1, 1}, {1, 2, \(-1\)}, {1, \(-2\), 1}}, {{3, 1, \(-1\)}, {4, 0, 0}, {3, \(-1\), 1}, {2, 0, 0}, {3, 1, \(-1\)}}, {{9/2, 1, 1}, {11/2, 0, 0}, {9/2, \(-1\), \(-1\)}, {7/2, 0, 0}, {9/2, 1, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[{ \(\(Show[curvs[4 dowtest, rad \[Rule] 0], AspectRatio \[Rule] Automatic];\)\), "\[IndentingNewLine]", \(Show[curvs[2 dowtest, chordno \[Rule] 3], V003]; crosscurv[dowtest]; dowth[]\)}], "Input", FontSize->9], Cell[BoxData[ \(\(dowtest2 = {{{1, \(-2\), 1}, {\(-1\), \(-1\), \(-1\)}, {2, 1, 1}, {2, \(-1\), \(-1\)}, {\(-1\), 1, 1}, {1, 2, \(-1\)}, {1, \(-2\), 1}}, {{3, 1, \(-1\)}, {4, 0, 0}, {3, \(-1\), 1}, {2, 0, 0}, {3, 1, \(-1\)}}, {{9/2, 1, 1}, {11/2, 0, 0}, {9/2, \(-1\), \(-1\)}, {7/2, 0, 0}, {9/2, 1, 1}}, {{6, 1, \(-1\)}, {7, 0, 0}, {6, \(-1\), 1}, {5, 0, 0}, {6, 1, \(-1\)}}, \[IndentingNewLine]{{4.5, .5, 1.5}, {4.5, 2, \(-2\)}, {6, 2, 1}, {6, .5, \(-2\)}, {4.5, 3, 1}, {6, 3, \(-2\)}, {4.5, .5, 1.5}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[{ \(\(Show[curvs[4 dowtest2, rad \[Rule] 0], AspectRatio \[Rule] Automatic];\)\), "\[IndentingNewLine]", \(Show[curvs[2 dowtest2, chordno \[Rule] 3], V003]; crosscurv[dowtest2]; dowth[]\)}], "Input", FontSize->9] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "6. Named Knots k", StyleBox["0c00n, ", FontSlant->"Italic"], "Knot Graphs kg", StyleBox["0c00n, ", FontSlant->"Italic"], "and ", StyleBox[" ", FontSlant->"Italic"], "Braids", StyleBox[" ", FontSlant->"Italic"], "b", StyleBox["0c00n", FontSlant->"Italic"], ". DataFile ", StyleBox["genKnots", FontSlant->"Italic"], "." }], "Section", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["6.1. Nomenclature.", "Subsection"], Cell[TextData[{ StyleBox["\tkcn", FontSlant->"Italic"], " is a ", StyleBox["lineList", FontSlant->"Italic"], " fo", "r the ", StyleBox["n", FontSlant->"Italic"], "'th knot with ", StyleBox["c", FontSlant->"Italic"], " crossings, ", StyleBox["c", FontSlant->"Italic"], " & ", StyleBox["n", FontSlant->"Italic"], " being left padded with zeroes to emulate [6]. ", StyleBox["bcn", FontSlant->"Italic"], " or ", StyleBox["bc[[n]] ", FontSlant->"Italic"], "is a braid of the ", StyleBox["n", FontSlant->"Italic"], "'th knot with ", StyleBox["c", FontSlant->"Italic"], " crossings (though it may have more than ", StyleBox["c", FontSlant->"Italic"], " crossings). The Conway notation, for the corresponding knot, is often \ included as a comment. ", StyleBox["bcn#m ", FontSlant->"Italic"], "is a composite knot.", "\n\t", StyleBox["nodeList", FontSlant->"Italic"], " is the signed list of under/overcrossings created by ", StyleBox["crossings[]", FontSlant->"Italic"], ". \n\tMost of the knots have starting points chosen so that ", StyleBox["knotGraph[name, par]", FontSlant->"Italic"], " makes the outside white when ", StyleBox["par", FontSlant->"Italic"], " is positive (the default value), to give the correct graph. As the \ resulting graphs have vertices on points related to the vertices of the knot \ diagram, they are untidy. ", StyleBox["kgcn ", FontSlant->"Italic"], "& ", StyleBox[" kgc[[n]] ", FontSlant->"Italic"], "are knot graphs with \"rectified\" vertices, adjusted to be on a small \ rectangular grid. " }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["6.2. Knots & Graphs with 3,4,5,6 vertices.", "Subsection"], Cell[BoxData[ \(\(kg31 = Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}}}, {{{\(-1\), 0}}, {{1, 0}}, {{0, 1}}}];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k04001 = {{{1, 0, 0}, {2, 2, 1}, {0, 3, 2}, {0, 1, 0}, {1, 0, 2}, {0, \(-1\), 1}, {\(-1\), 0, 0}, {0, 1, 2}, {0, 3, 0}, {\(-2\), 2, 1}, {\(-1\), 0, 2}, {1, 0, 0}}}; kg41 = Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}, ER}, {{2, 3}, ER}}, {{{0, 1}}, {{1, 0}}, {{\(-1\), 0}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k04001a = {{{0, 3, 2}, {0, 1, 0}, {1, 0, 2}, {0, \(-1\), 1}, {\(-1\), 0, 0}, {0, 1, 2}, {0, 3, 0}, {\(-2\), 2, 1}, {\(-1\), 0, 2}, {1, 0, 0}, {2, 2, 1}, {0, 3, 2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(kg05001 = Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 1}}}, {{{0, 0}}, {{1, 0}}, {{ .9, .5}}, {{1, 1}}, {{0, 1}}}]; kg05002 = Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{3, 4}}, {{4, 1}}}, {{{0, 1}}, {{1, 1}}, {{1, 0}}, {{0, 0}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k05002\ = {{{0, 8, 1}, {0, 5, \(-1\)}, {2, 2, 1}, {4, \(-2\), 0}, {0, 0, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 6, 0}, {0, 8, \(-1\)}, {0, 5, 1}, {\(-2\), 2, \(-1\)}, {\(-4\), \(-2\), 0}, {0, 0, 1}, {2, 2, \(-1\)}, {4, 6, 0}, {0, 8, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k06001 = {{{0, \(- .55\), 0}, {1, 0, 1}, {2, 2, \(-1\)}, {2, 4, 0}, {0, 4, 1}, {\(-1\), 3, 0}, {0, 2, \(-1\)}, {2, 1, 1}, {2.5, 0, 0}, {1, 0, \(-1\)}, {0, .75, 0}, {\(-1\), 0, 1}, {\(-2.5\), 0, 0}, {\(-2\), 1, \(-1\)}, {0, 2, 1}, {1, 3, 0}, {0, 4, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), 2, 1}, {\(-1\), 0, \(-1\)}, {0, \(- .55\), 0}}}; k06002 = {{{0, 0, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 6, 0}, {\(-2\), 8, \(-1\)}, {2, 8, 1}, {4, 6, 0}, {2, 2, \(-1\)}, {0, 0, 1}, {\(-3\), \(-1\), 0}, {\(-2\), 2, \(-1\)}, {0, 4, 1}, {2, 8, \(-1\)}, {0, 10, 0}, {\(-2\), 8, 1}, {0, 4, \(-1\)}, {2, 2, 1}, {3, \(-1\), 0}, {0, 0, \(-1\)}}}; k06003 = {{{ .8, 1, 1}, {2, .8, \(-1\)}, {2.5, 0, 0}, {1.5, 0, 1}, { .8, 1, \(-1\)}, {0, 2, 1}, {\(-1.5\), 2, 0}, {\(-2\), .8, \(-1\)}, {\(-1.5\), 0, 1}, {0, \(- .3\), 0}, {1.5, 0, \(-1\)}, {2, 1, 1}, {1.5, 2, 0}, {0, 2, \(-1\)}, {\(-2\), .8, 1}, {\(-2.5\), 0, 0}, {\(-1.5\), 0, \(-1\)}, { .8, 1, 1}}};\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(kg06001 = Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{1, 5}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, .9}}, {{0, 1}}}]; kg06002 = Graph[{{{1, 2}, ER}, {{2, 3}, ER}, {{3, 4}, ER}, {{4, 1}, ER}, {{4, 5}}, {{3, 5}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{0, 1}}, {{ .5, 1.5}}}]; kg06003 = Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{2, 3}}}, {{{0, 0}}, {{0, 1}}, {{1, 0}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["Composite knots:-", "Text"], Cell[BoxData[ \(k06c33 = {{{0, .25, 0}, {1, 1, 1}, {0, 1.5, \(-1\)}, {\(- .6\), .7, 1}, {\(- .6\), \(- .7\), \(-1\)}, {0, \(-1.5\), 1}, {1, \(-1\), \(-1\)}, {0, \(- .25\), 0}, {\(-1\), \(-1\), 1}, {0, \(-1.5\), \(-1\)}, { .6, \(- .7\), 1}, { .6, .7, \(-1\)}, {0, 1.5, 1}, {\(-1\), 1, \(-1\)}, {0, .25, 0}}}; kg06c33 = Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}}, {{3, 4}}, {{3, 5}}, {{4, 5}}}, {{{1, 3}}, {{\(-1\), 3}}, {{0, 0}}, {{\(-1\), \(-3\)}}, {{1, \(-3\)}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k06n33 = {{{0, 0, 0}, {1, 1, 1}, {0, 2, \(-1\)}, {\(-1\), .5, 1}, {\(-1\), \(-1\), \(-1\)}, {\(- .5\), \(-1.5\), 0}, {0, \(-1\), 1}, { .5, \(- .5\), \(-1\)}, {1, \(-1\), \(-1\)}, { .5, \(-2\), 0}, {\(- .5\), \(-2\), 0}, {\(-1\), \(-1\), 1}, {\(- .5\), \(- .5\), 0}, {0, \(-1\), \(-1\)}, { .5, \(-1.5\), 0}, {1, \(-1\), 1}, {1, .5, \(-1\)}, {0, 2, 1}, {\(-1\), 1, \(-1\)}, {0, 0, 0}}}; kg06n33 = Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}}, {{3, 4}}, {{3, 4}}, {{3, 4}}}, {{{1, 1}}, {{\(-1\), 1}}, {{0, \(-1\)}}, {{0, \(-2\)}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["6.3. Knots & Graphs with 7 vertices.", "Subsection"], Cell[BoxData[{ \(\(k07c34 = {{{0, .25, 0}, {1, .6, 1}, {0, 1.5, \(-1\)}, {\(- .6\), .3, 1}, {\(- .6\), \(- .8\), \(-1\)}, {0, \(-1.3\), 1}, { .5, \(-1.7\), 0}, {0, \(-2\), \(-1\)}, {\(-1\), \(-2\), 0}, {\(- .6\), \(- .8\), 1}, { .6, \(- .8\), \(-1\)}, {1, \(-2\), 0}, {0, \(-2\), 1}, {\(- .5\), \(-1.7\), 0}, {0, \(-1.3\), \(-1\)}, { .6, \(- .8\), 1}, { .6, .3, \(-1\)}, {0, 1.5, 1}, {\(-1\), .6, \(-1\)}, {0, .25, 0}}};\)\), "\n", \(\(kg07c34 = Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}}, {{3, 4}, ER}, {{3, 5}, ER}, {{4, 5}}, {{4, 5}}}, {{{1, 1}}, {{\(-1\), 1}}, {{0, 0}}, {{\(-1\), \(-1\)}}, {{1, \(-1\)}}}];\)\)}], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07001 = kn[7];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07002 = {{{0, 8, \(-1\)}, {0, 12, 1}, {5, 12, 0}, {4, 6, \(-1\)}, {4, 1, 1}, {3.5, \(-2\), 0}, {0, \(-2\), \(-1\)}, {\(-5\), 2, 1}, {\(-4\), 6, \(-1\)}, {0, 8, 1}, {0, 12, \(-1\)}, {\(-5\), 12, 0}, {\(-4\), 6, 1}, {\(-4\), 1, \(-1\)}, {\(-3.5\), \(-2\), 0}, {0, \(-2\), 1}, {5, 2, \(-1\)}, {4, 6, 1}, {0, 8, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07003 = {{{2, 2, \(-1\)}, {4, 6, 1}, {6, 16, 0}, {0, 16, \(-1\)}, {\(-2\), 14, 0}, {0, 12, 1}, {2, 10, 0}, {0, 8, \(-1\)}, {\(-4\), 6, 1}, {\(-5\), 2, 0}, {\(-2\), 2, \(-1\)}, {0, 3, 0}, {2, 2, 1}, {5, 2, 0}, {4, 6, \(-1\)}, {0, 8, 1}, {\(-2\), 10, 0}, {0, 12, \(-1\)}, {2, 14, 0}, {0, 16, 1}, {\(-6\), 16, 0}, {\(-4\), 6, \(-1\)}, {\(-2\), 2, 1}, {0, 1, 0}, {2, 2, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07004 = {{{2, 2, 1}, {4.5, 2.5, 0}, {4, 0, \(-1\)}, {2, \(-2\), 1}, {0, \(-2.5\), 0}, {\(-2\), \(-2\), \(-1\)}, {\(-4\), 0, 1}, {\(-4.5\), 2.5, 0}, {\(-2\), 2, \(-1\)}, {0, 0, 1}, {2, \(-2\), \(-1\)}, {4.5, \(-2.5\), 0}, {4, 0, 1}, {2, 2, \(-1\)}, {0, 2.5, 0}, {\(-2\), 2, 1}, {\(-4\), 0, \(-1\)}, {\(-4.5\), \(-2.5\), 0}, {\(-2\), \(-2\), 1}, {0, 0, \(-1\)}, {2, 2, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07005 = {{{0, \(-1\), 1}, {\(-2\), 1, \(-1\)}, {\(-4\), 5, 0}, {\(-2\), 8, 1}, {2, 8, \(-1\)}, {4, 5, 0}, {2, 1, 1}, {0, \(-1\), \(-1\)}, {\(-3\), \(-1\), 0}, {\(-2\), 1, 1}, {0, 3, \(-1\)}, {0, 5, 1}, {\(-2\), 8, \(-1\)}, {0, 10, 0}, {2, 8, 1}, {0, 5, \(-1\)}, {0, 3, 1}, {2, 1, \(-1\)}, {3, \(-1\), 0}, {0, \(-1\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07006 = {{{0, \(- .5\), \(-1\)}, {\(-2\), 1, 1}, {\(-5\), 3, \(-1\)}, {\(-8\), 2, 0}, {\(-5\), 1, 1}, {\(-2\), 2, \(-1\)}, {0, 4, 1}, {0, 7, \(-1\)}, {\(-4\), 7, 0}, {\(-6\), 2, 1}, {\(-4\), \(-1\), \(-1\)}, {0, 0, 1}, {2, 2, \(-1\)}, {3, 6, 0}, {0, 8, 1}, {\(-1\), 5, \(-1\)}, {2, 1, 1}, {2, \(-1\), 0}, {0, \(- .5\), \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k07007 = {{{1, 1, \(-1\)}, {2, 0, 1}, {2, \(-2\), 0}, {0, \(-2\), \(-1\)}, {\(-1\), \(-1\), 1}, {\(-1\), 1, \(-1\)}, {0, 2, 1}, {2, 2, 0}, {2, 0, \(-1\)}, {1, \(-1\), 1}, {\(-1\), \(-1\), \(-1\)}, {\(-1.1\), \(-2.2\), 0}, {0, \(-2\), 1}, {1, \(-1\), \(-1\)}, {1, 1, 1}, {0, 2, \(-1\)}, {\(-1.1\), 2.2, 0}, {\(-1\), 1, 1}, {1, 1, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(kg07 = {Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 7}}, {{7, 1}}}, {{{0, 0}}, {{ .5, .1}}, {{1, 0}}, {{ .9, .5}}, {{1, 1}}, {{0, 1}}, {{ .1, .5}}, {{1, 1}}}], Graph[{{{1, 2}}, {{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 1}}}, {{{0, 0}}, {{1, 0}}, {{ .9, .5}}, {{1, 1}}, {{0, 1}}, {{ .1, .5}}, {{1, 1}}}], Graph[{{{1, 2}}, {{1, 2}}, {{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 1}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, .9}}, {{0, 1}}, {{1, 1}}}], Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 1}}, {{2, 5}}}, {{{0, 0}}, {{ .5, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, .9}}, {{0, 1}}, {{1, 1}}}], Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 1}}, {{3, 5}}, {{3, 5}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, 1.5}}, {{0, 1}}, {{1, 1}}}], Graph[{{{1, 2}, ER}, {{1, 3}, ER}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}, ER}, {{2, 4}, ER}, {{4, 5}}}, {{{1, 1}}, {{1, 0}}, {{1.5, .5}}, {{0, 0}}, {{0, 1}}}], Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{2, 4}, ER}, {{4, 5}, ER}, {{2, 5}, ER}, {{1, 5}}}, {{{0, 0}}, {{ .5, .1}}, {{1, 0}}, {{1, 1}}, {{0, 1}}}]};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["6.4. Knots & Graphs with 8 vertices.", "Subsection"], Cell[BoxData[ \(\(kg08 = {Graph[{{{1, 2}}, {{1, 6}}, {{2, 3}}, {{3, 4}}, {{4, 5}, ER}, {{4, 5}, ER}, {{5, 7}}, {{6, 7}}}, {{{0, 2}}, {{\(-1\), 2}}, {{\(- .8\), 1}}, {{\(-1\), 0}}, {{1, 0}}, {{1, 2}}, {{ .8, 1}}}], Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 7}}, {{2, 3}, ER}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 7}}}, {{{1, 2}}, {{0, 3}}, {{\(-1\), 2}}, {{\(- .9\), 1}}, {{\(-1\), 0}}, {{1, 0}}, {{ .8, 1}}}], Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{2, 5}}, {{3, 4}}, {{4, 5}}}, {{{\(-1\), 0}}, {{1, 0}}, {{\(-1\), 1}}, {{0, .8}}, {{1, 1}}}], Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{2, 3}, ER}}, {{{\(-1\), 0}}, {{0, 1}}, {{1, 0}}}], Graph[{{{1, 2}}, {{1, 7}}, {{2, 3}}, {{2, 6}, ER}, {{3, 4}}, {{4, 5}}, {{5, 6}, ER}, {{5, 7}}}, {{{1, 2}}, {{2, 1}}, {{1, 0}}, {{\(-1\), 0}}, {{\(-2\), 1}}, {{0, .9}}, {{\(-1\), 2}}}], (*5*) \[IndentingNewLine]Graph[{{{1, 2}}, {{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}}, {{4, 5}}}, {{{1, 1}}, {{\(-1\), 1}}, {{0, 1.5}}, {{\(-1\), 0}}, {{1, 0}}}], Graph[{{{1, 2}}, {{1, 2}}, {{1, 2}}, {{1, 2}}, {{1, 3}}, {{2, 3}, ER}, {{2, 4}, ER}, {{3, 4}, ER}}, {{{0, 0}}, {{1, 0}}, {{0, 1}}, {{1, 1}}}], Graph[{{{1, 2}}, {{1, 4}}, {{2, 3}, ER}, {{2, 4}}, {{2, 4}}, {{2, 4}}, {{3, 4}, ER}, {{3, 4}, ER}}, {{{0, 1}}, {{1, 1}}, {{1, 0}}, {{0, 0}}}], Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}, ER}, {{2, 3}}, {{2, 5}}, {{3, 4}}, {{4, 5}}}, {{{0, 0}}, {{1, 0}}, {{0, 1}}, {{ .5, .9}}, {{1, 1}}}] (*9*) , Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{1, 4}, ER}, {{2, 3}}, {{2, 3}}, {{2, 4}, ER}}, {{{1, 0}}, {{0, 1}}, {{0, 0}}, {{1, 1}}}] (*10*) , Graph[{{{1, 2}}, {{1, 5}}, {{1, 5}}, {{1, 5}}, {{2, 3}}, {{3, 4}, ER}, {{3, 5}}, {{4, 5}, ER}}, {{{0, 0}}, {{0, 1}}, {{1, 1}}, {{1.5, .5}}, {{1, 0}}}] (*11*) , Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{1, 5}, ER}, {{2, 4}}, {{2, 4}}, {{2, 5}, ER}, {{3, 4}, ER}}, {{{0, 1}}, {{0, 0}}, {{1, 1}}, {{1, 0}}, {{\(- .5\), .5}}}] (*12*) , Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 5}}, {{1, 6}, ER}, {{2, 3}}, {{2, 6}, ER}, {{3, 4}}, {{4, 5}}}, {{{0, 0}}, {{ .5, 1.3}}, {{0, 2}}, {{1, 2}}, {{1, 0}}, {{ .5, .7}}}] (*13*) , Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 5}, ER}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 4}, ER}, {{4, 5}, ER}}, {{{0, 0}}, {{2, 1}}, {{2, 0}}, {{1, .9}}, {{0, 1}}}] (*14*) , Graph[{{{1, 2}}, {{1, 3}}, {{1, 5}}, {{1, 5}}, {{2, 3}}, {{3, 4}}, {{3, 5}}, {{4, 5}}}, {{{\(-1\), 0}}, {{\(-1\), 1}}, {{0, .9}}, {{1, 1}}, {{1, 0}}}] (*15*) , Graph[{{{1, 2}}, {{1, 3}}, {{1, 4}, ER}, {{2, 3}}, {{2, 4}, ER}, {{2, 4}, ER}, {{3, 4}, ER}, {{3, 4}, ER}}, {{{0, 2}}, {{\(-1\), 0}}, {{1, 0}}, {{0, 1}}}], Graph[{{{1, 2}}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}}, {{3, 4}, ER}, {{3, 5}, ER}, {{3, 5}, ER}, {{4, 5}}}, {{{0, 1}}, {{1, 1}}, {{ .5, .5}}, {{1, 0}}, {{0, 0}}}], Graph[{{{1, 2}}, {{1, 4}, ER}, {{1, 5}}, {{2, 3}}, {{2, 4}, ER}, {{3, 4}, ER}, {{3, 5}}, {{4, 5}, ER}}, {{{0, 0}}, {{0, 1}}, {{1, 1}}, {{ .5, .5}}, {{1, 0}}}], Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}}, {{1, 5}}, {{2, 3}}, {{2, 4}}, {{3, 4}}, {{4, 5}}}, {{{0, 0}}, {{1, 0}}, {{ .5, .5}}, {{1, 1}}, {{0, 1}}}], Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 5}}, {{2, 3}}, {{2, 4}}, {{3, 4}, ER}, {{4, 5}}}, {{{0, 0}}, {{1, 0}}, {{ .5, .5}}, {{1, 1}}, {{0, 1}}}] (*20*) , Graph[{{{1, 2}}, {{1, 5}}, {{2, 3}}, {{2, 4}, ER}, {{3, 4}}, {{3, 5}}, {{3, 5}}, {{4, 5}, ER}}, {{{0, 1}}, {{1, 1}}, {{1, 0}}, {{ .5, .5}}, {{0, 0}}}], Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{2, 3}, ER}, {{2, 4}}, {{2, 5}, ER}, {{2, 5}, ER}, {{4, 5}}}, {{{2, \(-1\)}}, {{0, 0}}, {{2, 1}}, {{\(-2\), 1}}, {{\(-2\), \(-1\)}}}] (*kg8c44*) , Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{2, 3}, ER}, {{3, 4}, ER}, {{3, 5}, ER}, {{4, 5}}, {{4, 5}}}, {{{1, 1}}, {{1, \(-1\)}}, {{0, 0}}, {{\(-1\), 1}}, {{\(-1\), \(-1\)}}}] (*kg8c44a*) };\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08001 = \[IndentingNewLine]{{{4, 2, 1}, {4, 0, 0}, {2, 0, \(-1\)}, {0, 1, \(-1\)}, {\(-2\), 0, 1}, {\(-4\), 0, 0}, {\(-4\), 2, \(-1\)}, {\(-3\), 4, \(-1\)}, {\(-3\), 8, 1}, {0, 8, \(-1\)}, {1, 7, \(-1\)}, {0, 6, 1}, {\(-3\), 6, \(-1\)}, {\(-5\), 4, 0}, {\(-4\), 2, 1}, {\(-2\), 0, \(-1\)}, {0, \(-1\), 0}, {2, 0, 1}, {4, 2, \(-1\)}, {5, 4, 0}, {3, 6, 1}, {0, 6, \(-1\)}, {\(-1\), 7, 0}, {0, 8, 1}, {3, 8, 0}, {3, 4, \(-1\)}, {4, 2, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08002 = {{{4, 4, \(-1\)}, {2, 8, 1}, {\(-2\), 8, \(-1\)}, {\(-4\), 4, 1}, {\(-4\), 0, \(-1\)}, {\(-2\), \(-1\), 0}, {0, 0, 1}, {2, 1, 1}, {5, 1, \(-1\)}, {6, 3, 0}, {4, 5, 1}, {0, 6, \(-1\)}, {\(-2\), 8, 1}, {0, 10, 0}, {2, 8, \(-1\)}, {0, 6, 1}, {\(-4\), 5, \(-1\)}, {\(-6\), 3, 0}, {\(-5\), 1, 1}, {\(-2\), 1, 1}, {0, 0, \(-1\)}, {2, \(-1\), 0}, {4, 0, 1}, {4, 4, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08003 = {{{1, 0, 0}, {0, 1, \(-1\)}, {\(-1\), 2, 0}, {0, 3, 1}, {1, 4, 0}, {0, 5, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), \(-1\), 1}, {\(-1\), \(-4\), \(-2\)}, {0, \(-5\), 0}, {1, \(-4\), 1}, {2, \(-1\), 1}, {2, 4, 0}, {0, 5, 1}, {\(-1\), 4, 0}, {0, 3, \(-1\)}, {1, 2, 0}, {0, 1, 1}, {\(-1\), 0, 0}, {0, \(-1\), 0}, {2.5, \(-2\), 2}, {2.5, \(-3\), \(-1\)}, {0, \(-4\), 0}, {\(-2.5\), \(-3\), 1}, {\(-2.5\), \(-2\), \(-2\)}, {0, \(-1\), 1}, {1, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08004 = {{{1, 2.5, \(-1\)}, {2.5, 1.5, 0}, {3, \(-1\), 0}, {2, \(-2.5\), 1}, {1, \(-2\), 0}, {1.5, \(-1\), \(-1\)}, {2, 0, 1}, {1, .5, 0}, {0, .5, \(-1\)}, {\(-1\), 0, 1}, {\(- .5\), \(-1\), 1}, {0, \(-2\), \(-1\)}, {\(-1\), \(-3\), 0}, {1, \(-4\), 0}, {2, \(-2.5\), \(-1\)}, \[IndentingNewLine]{1.5, \(-1\), 1}, {1, 0, 0}, {1, 1.5, \(-1\)}, {0, 2.5, 1}, {\(-1.5\), 1, 0}, {\(-1.75\), \(-2\), 0}, {\(-1\), \(-4\), \(-1\)}, {0, \(-3\), 0}, {\(-1\), \(-2\), 1}, {\(- .5\), \(-1\), 0}, {0, 0, 1}, {0, 1.5, 1}, {1, 2.5, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08005 = {{{0, \(-3\), 1}, {3, \(-3\), \(-1\)}, {2, 0, 1}, {1, 1, 1}, {0, 0, \(-1\)}, {\(-1\), \(-1\), 0}, {\(-2\), 1, 1}, {\(-1\), 4, \(-1\)}, (*\({0, 4, 0}\)\(,\)*) {1, 4, 1}, {2, 1, 1}, {1, \(-1\), 0}, {0, 0, 1}, {\(-1\), 1, 0}, {\(-2\), 0, \(-1\)}, {\(-3\), \(-3\), 1}, {0, \(-3\), 0}, {3, \(-1\), 1}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-3\), \(-1\), \(-1\)}, {0, \(-3\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(kg08005 = Graph[{{{1, 2}}, {{1, 7}}, {{2, 3}}, {{2, 6}, ER}, {{3, 4}}, {{4, 5}}, {{5, 6}, ER}, {{5, 7}}}, {{{1, 2}}, {{2, 1}}, {{1, 0}}, {{\(-1\), 0}}, {{\(-2\), 1}}, {{0, 1}}, {{\(-1\), 2}}}];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08006 = {{{0, 0, 1}, {1, 1, 0}, {0, 2, \(-1\)}, {\(-1\), 3, 0}, {0, 4, 1}, {1, 5, \(-1\)}, {0, 6.5, 0}, {\(-1\), 5, 0}, {0, 4, \(-1\)}, {1, 3, 0}, {0, 2, 1}, {\(-1\), 1, 0}, {0, 0, \(-1\)}, {1, \(-1\), 1}, {1.5, \(-2.5\), 0}, {0, \(-2\), \(-1\)}, {\(-1\), \(-1\), 1}, {\(-2\), 2, 0}, {\(-1\), 5, \(-1\)}, {1, 5, 1}, {2, 2, 0}, {1, \(-1\), \(-1\)}, {0, \(-2\), 0}, {\(-1.5\), \(-2.5\), \(-1\)}, {\(-1\), \(-1\), \(-1\)}, {0, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08007 = {{{1, \(-1\), \(-1\)}, {3, 2, 2}, {4, 4, 2}, {3, 6, \(-1\)}, {0, 5, 2}, {\(-3\), 5, 2}, {\(-4\), 7, \(-1\)}, {\(-1\), 9, 1}, {2, 7, 2}, {2.5, 5, 1}, {1, 3, \(-1\)}, {\(-4\), 2, 2}, {\(-4\), 0, 1}, {\(-2\), 0, \(-1\)}, {0, 1, 1}, {2, 0, 2}, {4, 1, 1}, {1, 3, 1}, {0, 5, \(-1\)}, {\(-2\), 7, 0}, {\(-4\), 5, 2}, {\(-3\), 2, \(-1\)}, {\(-2\), 0, 2}, {1, \(-1\), \(-1\)}}};\)\)], "Input",\ PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08008 = {{{1, 0, \(-1\)}, {6, 0, 6}, {6, 5, \(-1\)}, {0, 5, 6}, {\(-4\), 2, \(-2\)}, {0, \(-1\), 2}, {1.5, 5, \(-1\)}, {\(-1\), 9, 6}, {\(-1\), 13, 2}, {4, 12, \(-1\)}, \[IndentingNewLine]{8, 8, 6}, {10, 1, 2}, {6, \(-1\), \(-1\)}, {4, 5, 6}, {8, 9, \(-1\)}, {8, 13, 2}, {4, 13, 6}, {0, 9, \(-1\)}, {\(-2\), 4, 6}, {1, 0, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08009 = {{{0, 2, 1}, {1, 3, 0}, {2, 2, \(-1\)}, {3, 1, 0}, {4, 2, 1}, {5, 3, 0}, {6, 2, \(-1\)}, {6.5, 1, 0}, {6, 0, 1}, {5, \(-1\), \(-1\)}, {3.5, \(-1\), 0}, {4, 0, 1}, {5, 1, \(-1\)}, {6, 2.5, 1}, {5, 4, 0}, {1, 4, 0}, {0, 2, \(-1\)}, {1, 1, 0}, {2, 2, 1}, {3, 3, 0}, {4, 2, \(-1\)}, {5, 1, 1}, {6, 0, \(-1\)}, {6.5, \(-1\), 0}, {5, \(-1\), 1}, {3.5, 0, \(-1\)}, {1, 0, 0}, {0, 2, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08010ng = (*A3 .17 . \ 3 - bridge . \ knotGraph\ fails*) {{{\(- .5\), 0, \(-1\)}, {1, 1, 1}, {2, 0, 0}, {1, \(-1\), \(-1\)}, {\(- .5\), 0, 1}, {\(-2\), 2, \(-1\)}, {0, 3, 1.5}, {1.2, 1, \(-1\)}, {1.3, \(-1\), 1}, {1, \(-3.5\), \(-1.5\)}, \[IndentingNewLine]{\(- .5\), \ \(-3.5\), 1}, {\(-1.5\), \(-1\), \(-1\)}, {\(-1\), 1.3, 1.5}, {1.5, 2.5, \(-1\)}, {3, 0, \(- .5\)}, {1.5, \(-2\), 1.5}, {\(-1\), \(-3\), \(-1\)}, {\(-2.5\), \(-2\), 1}, {\(- .5\), 0, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08010 = {{{0, 0, \(-1.5\)}, {1, 1, 1}, {2, 0, 0}, {1, \(-1\), \(-1\)}, {\(- .5\), 0, 1}, {\(-3\), 2, \(-1\)}, {0, 3, 1.5}, {1.2, 1, \(-1\)}, {1.3, \(-1\), 1}, {0, \(-3.5\), \(-1.5\)}, {\(-2.5\), \(-4\), 1}, {\(-1.5\), \(-2.5\), 1}, {\(-1.5\), \(-1\), \(-1\)}, {\(-1.5\), 1.3, 1.5}, {\(-2\), 3, \(-1\)}, {\(-4\), 3, 0}, {\(-4\), \(-1\), 0}, {\(-3\), \(-5\), 0}, {\(-1\), \(-4\), 1. }, {\(-1.5\), \(-2.5\), \(-1.5\)}, {\(-2.5\), \(-1.25\), 1.5}, {0, 0, \(-1.5\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08011 = {{{0, 5, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), 1, 1}, {\(-1\), \(-1\), \(-1\)}, {1, \(-1\), 1}, {2, 1, \(-1\)}, {2, 4, 0}, {0, 5, 1}, {\(-1\), 4, 0}, {0, 3, \(-1\)}, {1, 2, 0}, {0, 1, 1}, {\(-2\), 0, \(-1\)}, {\(-2\), \(-1\), 0}, {\(-1\), \(-1\), 1}, { .5, 0, \(-1\)}, {2, 1, 1}, {2, \(-1\), 0}, {1, \(-1\), \(-1\)}, { .5, 0, 1}, {0, 1, \(-1\)}, {\(-1\), 2, 0}, {0, 3, 1}, {1, 4, 0}, {0, 5, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08012 = {{{\(-1\), \(-1\), 1}, {0, 1, \(-1\)}, {1, 2.3, 0}, {\(- .5\), 3, 1}, {\(-2.5\), 3, \(-1\)}, {\(-3.5\), 4, 0}, {\(-2.5\), 5, 1}, {\(- .5\), 5, \(-1\)}, {1, 6, 0}, {0, 7, 1}, {\(-2\), 6.5, 0}, {\(-2.5\), 5, \(-1\)}, {\(-2\), 3, 1}, {\(-1\), 0, \(-1\)}, {0, \(-1\), 0}, {1, 0, 1}, {2, 3, 0}, {2, 6, 0}, {0, 7, \(-1\)}, {\(-1\), 5, 1}, {\(-1\), 3, \(-1\)}, {0, 1, 1}, {1, \(-1\), \(-1\)}, {0, \(-2\), 0}, {\(-1\), \(-1\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08013 = {{{0, 3, 1}, {2, 3.2, 0}, {1, 2, \(-1\)}, {\(-1\), 2, 1}, {\(-2.5\), 1, \(-1\)}, {\(-2.5\), \(-1\), 0}, {\(-1\), \(-2\), 1}, {1, \(-2\), \(-1\)}, {2.2, \(-1\), 0}, {1.3, 0, 1}, {\(-1.3\), 0, \(-1\)}, {\(-2.5\), 1, 1}, {\(-2\), 3, 0}, {0, 3, \(-1\)}, {1, 2, 1}, {1.3, 0, \(-1\)}, {1, \(-2\), 1}, {0, \(-3\), 0}, {\(-1\), \(-2\), \(-1\)}, {\(-1.3\), 0, 1}, {\(-1\), 2, 0}, {0, 3, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08014 = {{{0, 0, 1}, {1, \(-1\), \(-1\)}, {2, \(-2\), 1}, {3, \(-1.5\), 0}, {4, 0, \(-1\)}, {3, 1, 0}, {2, 0, 1}, {2, \(-2\), \(-1\)}, {0, \(-2\), 1}, {\(-1\), \(- .5\), \(-1\)}, {\(-1.5\), 1, 0}, {0, 2, 1}, {1, 1, 0}, {0, 0, \(-1\)}, {\(-1\), \(- .5\), 1}, {\(-1.5\), \(-2\), 0}, {0, \(-2\), \(-1\)}, {1, \(-1\), 1}, {2, \(- .5\), \(-1\)}, {3, 0, 1}, {2.5, 2, 0}, {0, 2, \(-1\)}, {0, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08015 = {{{0, 1, 1}, {1, 2, 0}, {0, 3, \(-1\)}, {\(-1.5\), 3, 0}, {\(-2\), 1, 1}, {\(-2\), \(-1\), \(-1\)}, {0, \(-2\), 0}, {2, \(-1\), 1}, {2, 1, \(-1\)}, {1.5, 3, 0}, {0, 3, 1}, {\(-1\), 2, 0}, {0, 1, \(-1\)}, {1, 0, 1}, {2, \(-1\), \(-1\)}, {3, 0, 0}, {2, 1, 1}, {1, 0, \(-1\)}, {0, \(-1\), 0}, {\(-1\), 0, 1}, {\(-2\), 1, \(-1\)}, {\(-3\), 0, 0}, {\(-2\), \(-1\), 1}, {\(-1\), 0, \(-1\)}, {0, 1, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08016 = {{{1, 0, 1}, {2, 2, \(-1\)}, {2, 4, 0}, {0, 4, 1}, {\(-1\), 3, \(-1\)}, {0, 1, 1}, {1, 0, \(-1\)}, {2, 0, 0}, {2, 1, 1}, {1, 2, \(-1\)}, {\(-1\), 2, 1}, {\(-2\), 1, \(-1\)}, {\(-2\), 0, 0}, {\(-1\), 0, 1}, {0, 1, \(-1\)}, {1, 3, 1}, {0, 4, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), 2, 1}, {\(-1\), 0, \(-1\)}, {1, 0, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08017 = {{{0, 0, 0}, {\(-2\), 2, \(-1\)}, {\(-2\), 4, 1}, {\(-1.5\), 6, \(-1\)}, {0, 8, 1}, {3, 8, 0}, {4, 6, \(-1\)}, {2, 4, 1}, {\(-2\), 4, \(-1\)}, {\(-3\), 5, 0}, {\(-1\), 6, 1}, {1, 6.3, \(-1\)}, {4, 6, 1}, {5, 3.5, 0}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 4, 0}, {\(-3\), 7, 0}, {0, 8, \(-1\)}, {2, 6, 1}, {2, 4, \(-1\)}, {2, 2, 1}, {0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08018 = \ {{{0, \(-2\), \(-1\)}, {\(-2\), 0, 2}, {\(-3\), 3, \(-1\)}, {0, 6, 1}, {3, 3, 2}, {2, 0, \(-1\)}, {0, \(-2\), 2}, {\(-3\), \(-3\), \(-1\)}, {\(-6\), 0, 1}, {\(-3\), 3, 2}, {0, 2, \(-1\)}, {2, 0, 2}, {3, \(-3\), \(-1\)}, {0, \(-6\), 1}, {\(-3\), \(-3\), 2}, {\(-2\), 0, \(-1\)}, {0, 2, 2}, {3, 3, \(-1\)}, {6, 0, 1}, {3, \(-3\), 2}, {0, \(-2\), \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08019 = {{{0, 0, 0}, {\(-2\), 2, 1}, {\(-2\), 4, 1}, {\(-1.5\), 6, \(-1\)}, {0, 8, \(-1\)}, {3, 8, 0}, {4, 6, 1}, {2, 4, \(-1\)}, {\(-2\), 4, \(-1\)}, {\(-3\), 5, 0}, {\(-1\), 6, 1}, {1, 6.3, \(-1\)}, {4, 6, \(-1\)}, {5, 3.5, 0}, {2, 2, 1}, {\(-2\), 2, \(-1\)}, {\(-4\), 4, 0}, {\(-3\), 7, 0}, {0, 8, 1}, {2, 6, \(-1\)}, {2, 2, \(-1\)}, {0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08020 = {{{0, 0, 0}, {\(-2\), 2, \(-1\)}, {\(-2\), 4, 1}, {\(-1.5\), 6, \(-1\)}, {0, 8, 1}, {3, 8, 0}, {4, 6, 1}, {3, 4, \(-1\)}, {\(-2\), 4, \(-1\)}, {\(-3\), 5, 0}, {\(-1\), 6, 1}, {1, 6.3, 1}, {4, 6, \(-1\)}, {5, 3.5, 0}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 4, 0}, {\(-3\), 7, 0}, {0, 8, \(-1\)}, {2, 6, \(-1\)}, {2, 2, 1}, {0, 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(\(k08021ng = {{{0, 0, 0}, {\(-2\), 2, \(-1\)}, {\(-2\), 4, \(-1\)}, {\(-1.5\), 6, 1}, {0, 8, \(-1\)}, {3, 8, 0}, {4, 6, \(-1\)}, {3, 4, 1}, {\(-2\), 4, 1}, {\(-3\), 5, 0}, {\(-1\), 6, \(-1\)}, {4, 6, 1}, {5, 3.5, 0}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 5, 1}, {0, 8, 1}, {2, 5, \(-1\)}, {2, 2, 1}, {0, 0, 0}}};\)\( (*Shadow\ same\ as\ previous . \ knotGraph\ fails . \ LH\ region\ moved\ to\ RH\ in\ next\ \(\(diagram\)\(.\)\)*) \ \)\)\)], "Input", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(\(k08021 = {{{3, \(-1\), \(-1\)}, {1, 1, \(-1\)}, {0, 4, \(-1\)}, {0, 6, 1}, {1, 8, \(-1\)}, {3.1, 8, 0}, {4, 6, \(-1\)}, {2, 4, 1}, {\(-1\), 4, 1}, {\(-2\), 5, 0}, {0, 6, \(-1.5\)}, {4, 6, 1}, {5.5, 4, 0}, {5, 2, \(-1\)}, {4.5, 0, 1}, {7, 0, 0}, {7, 4, 1}, {6, 7, 0}, {3.2, 8, \(-1\)}, {1.3, 6, 1}, {2, 4, \(-1\)}, {6, 1, 1}, {3, \(-1\), \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k08c44 = {{{\(- .8\), 2, 1}, { .8, 2, 1}, {1.5, 1, 0}, {1, 0, \(-1\)}, { .5, \(-1\), 1}, {1, \(-1.5\), 0}, {1.5, \(-1\), \(-1\)}, {1, 0, 1}, { .5, 1, 0}, {1, 2, \(-1\)}, {2, 1.5, \(- .3\)}, {2, \(- .5\), 1}, {0, \(-1\), 0}, {\(-2\), \(- .5\), 1}, {\(-2\), 1.5, \(- .3\)}, {\(-1\), 2, \(-1\)}, {\(- .5\), 1, 0}, {\(-1.5\), \(-1\), \(-1\)}, {\(-1\), \(-1.5\), 0}, {\(- .5\), \(-1\), 1}, {\(-1\), 0, \(-1\)}, {\(-1.5\), 1, 0}, {\(- .8\), 2, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["6.5. Knots & Graphs with 9 or more vertices.", "Subsection"], Cell["Various graphs mentioned in [4] etc:-", "Text"], Cell[BoxData[{ \(\(k09023 = {{{0, 0, 1}, {1, 1, \(-1\)}, {2, 1, 0}, {2, 0, 1}, { .8, \(-1\), \(-1\)}, \[IndentingNewLine]{1, \(-2\), 1}, {2.5, \(-2\), 0}, {2, 0, \(-1\)}, {1, 1, 1}, {0, 1.3, 0}, {\(-1\), 1, \(-1\)}, \[IndentingNewLine]{\(-2\), 0, 1}, {\(-2.5\), \(-2\), 0}, {\(-1\), \(-2\), \(-1\)}, {\(- .8\), \(-1\), 1}, {\(-2\), 0, \(-1\)}, \[IndentingNewLine]{\(-2\), 1, 0}, {\(-1\), 1, 1}, {0, 0, \(-1\)}, {1, \(-1\), 1}, {1, \(-2.5\), \(-1\)}, {\(-1\), \(-2.5\), 1}, {\(-1\), \(-1\), \(-1\)}, {0, 0, 1}}};\)\), "\n", \(\(kg09023 = Graph[{{{1, 2}}, {{1, 4}}, {{1, 5}}, {{2, 3}}, {{3, 4}}, {{3, 4}}, {{4, 6}}, {{4, 6}}, {{5, 6}}}, {{{0, 1}}, {{\(-1\), 1}}, {{\(-1\), 0}}, {{0, 0}}, {{1, 1}}, {{1, 0}}}];\)\)}], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["Three more knots with the same shadow:-", "Text", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(\(k09039 = {{{\(-1\), \(- .1\), 1}, {1, \(- .1\), \(-1\)}, {2.5, \(-1\), 1}, {2.5, \(-2\), 0}, {1, \(-2\), \(-1\)}, {0, \(-1\), 1}, {\(-1\), 0, \(-1\)}, {0, 1, 1}, {1, 2, 0}, {0, 3, \(-1\)}, \[IndentingNewLine]{\(-1.5\), 3, 0}, {\(-2\), 0, 1}, {\(-1\), \(-2\), \(-1\)}, {1, \(-2\), 1}, {2, 0, \(-1\)}, {1.5, 3, 0}, {0, 3, 1}, {\(-1\), 2, 0}, {0, 1, \(-1\)}, {1, 0, 1}, {0, \(-1\), \(-1\)}, {\(-1\), \(-2\), 1}, {\(-2.5\), \(-2\), 0}, {\(-2.5\), \(-1\), \(-1\)}, {\(-1\), \(- .1\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k09048 = {{{\(-1\), \(- .1\), \(-1\)}, {1, \(- .1\), 1}, {2.5, \(-1\), 1}, {2.5, \(-2\), 0}, {1, \(-2\), \(-1\)}, {0, \(-1\), 1}, {\(-1\), 0, 1}, {0, 1, \(-1\)}, {1, 2, 0}, {0, 3, 1}, \[IndentingNewLine]{\(-1.5\), 3, 0}, {\(-2\), 0, 1}, {\(-1\), \(-2\), \(-1\)}, {1, \(-2\), 1}, {2, 0, \(-1\)}, {1.5, 3, 0}, {0, 3, \(-1\)}, {\(-1\), 2, 0}, {0, 1, 1}, {1, 0, \(-1\)}, {0, \(-1\), \(-1\)}, {\(-1\), \(-2\), 1}, {\(-2.5\), \(-2\), 0}, {\(-2.5\), \(-1\), \(-1\)}, {\(-1\), \(- .1\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(k09049 = {{{\(-1\), \(- .1\), 1}, {1, \(- .1\), \(-1\)}, {2.5, \(-1\), 1}, {2.5, \(-2\), 0}, {1, \(-2\), \(-1\)}, {0, \(-1\), 1}, {\(-1\), 0, \(-1\)}, {0, 1, \(-1\)}, {1, 2, 0}, {0, 3, 1}, \[IndentingNewLine]{\(-1.5\), 3, 0}, {\(-2\), 0, 1}, \[IndentingNewLine]{\(-1\), \(-2\), \(-1\)}, {1, \(-2\), 1}, {2, 0, \(-1\)}, {1.5, 3, 0}, {0, 3, \(-1\)}, {\(-1\), 2, 0}, {0, 1, 1}, {1, 0, 1}, {0, \(-1\), \(-1\)}, {\(-1\), \(-2\), 1}, {\(-2.5\), \(-2\), 0}, {\(-2.5\), \(-1\), \(-1\)}, {\(-1\), \(- .1\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k1000a = {{{2, 0, \(-1\)}, {4, 2, 1}, {5, 4, 1}, {3, 6, \(-1\)}, \[IndentingNewLine]{4, 8, 1}, {4, 11, 1}, {0, 11, \(-1\)}, {\(-1\), 10, 1}, {0, 9, 3}, {4, 8, \(-1\)}, {5, 6, 1}, {3, 4, 1}, {4, 2, \(-1\)}, {4, 0, 1}, {2, 0, 3}, {0, 1, 1}, {\(-2\), 0, \(-1\)}, {\(-4\), 0, 1}, {\(-4\), 2, 3}, {\(-3\), 4, 1}, {\(-5\), 6, \(-1\)}, {\(-4\), 8, 1}, {0, 9, \(-1\)}, {1, 10, 1}, {0, 11, 3}, {\(-4\), 11, 1}, {\(-4\), 8, \(-1\)}, {\(-3\), 6, 1}, {\(-5\), 4, 1}, {\(-4\), 2, \(-1\)}, {\(-2\), 0, 1}, {0, \(-1\), 1}, {2, 0, \(-1\)}}}; kg1000a = Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 7}}, {{7, 8}}, {{8, 9}}, {{9, 1}}}, {{{1, 0}}, {{2, 0}}, {{3, 0}}, {{3, 1}}, {{3, 2}}, {{1.5, 2}}, {{0, 2}}, {{0, 1}}, {{0, 0}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["\<\ k10129 and k88 have same HOMFLY but different Kaufman polynomials.\ \>", "Text", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(k10129 = {{{0, \(-2\), \(-3\)}, {2, 1, 4}, {0, 4, 0}, {\(-2\), 6, 2}, {0, 8, 4}, {2, 11, 3}, {\(-2\), 13, 0}, {\(-4\), 8, 0}, {\(-4\), 1, 0}, {\(-2\), \(-4\), 0}, {2, \(-4\), 0}, {4, 1, 0}, {4, 8, 1}, {2, 13, 4}, {\(-2\), 11, 2}, {0, 8, 0}, {2, 6, 2}, {0, 4, 4}, {\(-2\), 1, 0}, {0, \(-2\), 4}, {3, \(-4\), \(-4\)}, {5, \(-4\), 4}, {4, \(-1\), 2}, {3, 1, 2}, {1, 2, \(-4\)}, {\(-1\), 2, 4}, {\(-3\), 1, 1}, {\(-4\), \(-1\), \(-4\)}, {\(-5\), \(-4\), \(-4\)}, {\(-3\), \ \(-4\), 4}, {0, \(-2\), \(-3\)}}}; kg10129 = Graph[{{{1, 2}, ER}, {{1, 3}, ER}, {{1, 5}, ER}, {{2, 3}}, {{2, 3}}, {{2, 3}}, {{2, 6}}, {{3, 4}}, {{4, 5}}, {{5, 6}}}, {{{0, .5}}, {{\(-1\), 0}}, {{1, 0}}, {{1, 1}}, {{0, 1}}, {{\(-1\), 1}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k10104 = {{{0, 0, \(-1\)}, {4, \(-4\), 2}, {8, 0, 3}, {8, 12, \(-1\)}, {0, 18, 3}, {\(-8\), 16, 2}, {\(-12\), 8, \(-1\)}, {\(-12\), 0, 3}, {\(-6\), \(-8\), 2}, {6, \(-8\), 1}, {12, 0, \(-1\)}, {12, 8, 3}, {8, 16, 2}, {0, 18, \(-1\)}, {\(-8\), 12, 3}, {\(-8\), 0, \(-1\)}, {\(-4\), \(-4\), 2}, {0, 0, 3}, {4, 4, 2}, {8, 0, \(-1\)}, {12, \(-2\), 3}, {16, 1, 2}, {12, 8, \(-1\)}, {8, 12, 3}, {0, 14, 2}, {\(-8\), 12, \(-1\)}, {\(-12\), 8, 3}, {\(-16\), 1, 2}, {\(-12\), \(-2\), \(-1\)}, {\(-8\), 0, 3}, {\(-4\), 4, 2}, {0, 0, \(-1\)}}}; kg10104 = Graph[{{{1, 2}, ER}, {{1, 6}, ER}, {{2, 3}, ER}, {{2, 4}}, {{2, 4}}, {{3, 4}}, {{3, 5}, ER}, {{4, 5}}, {{4, 5}}, {{5, 6}, ER}}, {{{1, 0}}, {{1, 1}}, {{0, 1.5}}, {{0, 1}}, {{\(-1\), 1}}, {{\(-1\), 0}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k10105 = {{{0, 0, \(-1\)}, {2, 2, 2}, {2, 4, \(-1\)}, {0, 6, 2}, {\(-2\), 7, 1}, {\(-4\), 6, \(-1\)}, {\(-3\), 3, 2}, {0, 3, \(-1\)}, {2, 4, 2}, {4, 3, \(-1\)}, {2, \(-2\), 2}, {\(-2\), \(-2\), \(-1\)}, {\(-5\), 2, 1}, {\(-4\), 5, 2}, {0, 5, \(-1\)}, {4, 5, 1}, {5, 3, 2}, {2, 2, \(-1\)}, {0, 3, 2}, {\(-2\), 4, 1}, {\(-3\), 3, \(-1\)}, {0, 0, 2}, {2, \(-2\), \(-1\)}, {0, \(-4\), 1}, {\(-2\), \(-2\), 2}, {0, 0, \(-1\)}}}; kg10105 = Graph[{{{1, 2}}, {{1, 5}, ER}, {{1, 6}}, {{2, 3}, ER}, {{2, 6}}, {{3, 4}, ER}, {{4, 5}, ER}, {{4, 6}}, {{4, 7}}, {{6, 7}}}, {{{0, 0}}, {{1, 0}}, {{2, 0}}, {{3, 0}}, {{1.5, .5}}, {{0, \(-1\)}}, {{3, \(-1\)}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["\<\ The next two are the same knot (Perko) but have writhes of -8 and +10 \ [5,p25].\ \>", "Text", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(k10161 = {{{0, \ 0, \ \(-1\)}, \ {1, \(-1\), 0}, \ {2, \ 0, \ 1}, \ {2, \ 3, \ \(-1\)}, \ {0, \ 5, \ 1}, \ {\(-2\), \ 5, 0}, \ {\(-3\), \ 2, \ 1}, \ {\(-5\)/2, \(-1\)/2, \ \(-1\)}, \ {\(-1\), \(-2\), \ \(-1\)/ 2}, \ {1, \(-2\), \ 1/2}, \ {5/2, \(-1\)/2, 1}, \ {3, \ 2, \(-1\)}, \ {2, \ 5, \ 0}, \ {0, \ 5, \ \(-1\)}, \ {\(-2\), \ 3, \ 1}, \ {\(-2\), \ 0, \(-1\)}, \ {\(-1\), \(-1\), \ 0}, \ {0, \ 0, \ 1}, \ {1, \ 1, 0}, \ {2, \ 0, \ \(-1\)}, \ {5/2, \(-1\)/2, \(-1\)}, \ {\ 7/2, \ 1/4, \(-1\)}, \ {3, \ 2, \ 1}, \ {2, \ 3, \ 1}, \ {0, \ 7/2, \ 0}, \ {\(-2\), \ 3, \ \(-1\)}, \ {\(-3\), \ 2, \(-1\)}, \ {\(-7\)/2, \ 1/4, 0}, \ {\(-5\)/2, \(-1\)/2, \ 1}, \ {\(-2\), \ 0, \ 1}, \ {\(-1\), \ 1, \ 0}, {0, \ 0, \ \(-1\)}}}; kg10161 = Graph[{{{1, 2}}, {{1, 3}}, {{1, 5}}, {{1, 5}}, {{1, 5}}, {{2, 3}, ER}, {{2, 6}}, {{3, 4}}, {{4, 5}}, {{5, 6}}}, {{{0, 1}}, {{\(-1\), 0}}, {{1, 0}}, {{1, 2}}, {{0, 2}}, {{\(-1\), 2}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k10161a = {{{0, 0, \(-1\)}, \ {1, \ 1, \ 1}, \ {1, \ 2, \(-1\)}, \ {0, \ 3, \ \(-1\)}, \ {\(-1\), \ 4, \ 0}, \ {\(-2\), \ 3, \ 1}, \ {\(-3\)/2, \ 3/2, \ \(-1\)}, \ {0, \ 3/2, \ 1}, \ {1, \ 2, \ 1}, \ {2, 3/2, \ \(-1\)}, \ {1, \(-1\), \ 1}, \ {\(-1\), \(-1\), \ \(-1\)}, \ {\(-5\)/2, \ 1, \(-1\)}, \ {\(-2\), \ 3, \ \(-1\)}, \ {0, \ 3, \ 1}, \ {2, \ 3, \ 1}, \ {5/2, \ 3/2, \ 3/2}, \ {1, \ 1, \(-1\)}, \ {\ 0, \ 3/2, \ \(-1\)}, \ {\(-1\), \ 2, \ 1/2}, \ {\(-3\)/2, \ 3/2, 3/2}, \ {\(-5\)/4, \ 3/4, 0}, \ {0, \ 0, \ 1}, \ {1, \(-1\), \ \(-1\)}, \ {0, \(-5\)/2, \ 0}, \ {\(-1\), \(-1\), 1}, {0, 0, \(-1\)}}}; kg10161a = Graph[{{{1, 2}}, {{1, 5}}, {{1, 6}}, {{2, 3}}, {{2, 6}}, {{3, 4}}, {{4, 5}}, {{4, 6}}, {{4, 7}}, {{6, 7}}}, {{{0, 1}}, {{1, 2}}, {{\(-1\), 2}}, {{\(-1\), 0}}, {{\(-1\), 1}}, {{1, 1}}, {{1, 0}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k11xxx = {{{0, 0, \(-1\)}, {2, 2, 2}, {0, 4, \(-1\)}, {\(-2\), 6, 1}, {0, 8, 2}, {2, 10, 1}, {0, 12, \(-1\)}, {\(-2\), 14, 1}, {0, 15, 2}, {4, 14, 1}, {4, 0, \(-1\)}, {2, \(-4\), 2}, {\(-2\), \(-4\), \(-1\)}, {\(-4\), 0, 2}, {\(-4\), 14, 0}, {0, 15, \(-1\)}, {2, 14, 1}, {0, 12, 2}, {\(-2\), 10, 1}, {0, 8, \(-1\)}, {2, 6, 1}, {0, 4, 2}, {\(-2\), 2, \(-1\)}, {0, 0, 2}, {2, \(-3\), \(-1\)}, {5, \(-4\), 1}, {4, 0, 2}, {2, 2, \(-1\)}, {\(-2\), 2, 2}, {\(-4\), 0, \(-1\)}, {\(-5\), \(-4\), 1}, {\(-2\), \(-3\), 2}, {0, 0, \(-1\)}}}; kg11xxx = Graph[{{{1, 2}}, {{1, 3}}, {{1, 5}}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 4}}, {{3, 6}}, {{4, 5}}, {{5, 6}}}, {{{0, 1}}, {{\(-1\), 0}}, {{1, 0}}, {{\(-1\), 2}}, {{0, 2}}, {{1, 2}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(k11255 = {{{0, \(-2\), \(-4\)}, {4, 4, 4}, {8, 0, \(-4\)}, {8, \(-8\), 4}, \[IndentingNewLine]{18, \(-8\), \(-4\)}, {18, 0, 4}, {12, 0, \(-4\)}, {8, 0, 4}, {4, 4, \(-4\)}, \[IndentingNewLine]{4, 8, 4}, {8, 12, 2}, {18, 12, \(-2\)}, {20, 6, \(-4\)}, {14, 6, 4}, \[IndentingNewLine]{0, 8, \(-4\)}, {0, \(-4\), 4}, {8, \(-6\), \(-4\)}, {12, 0, 4}, {12, 6, \(-4\)}, \[IndentingNewLine]{16, 8, 0}, {20, 4, 0}, {24, \(-4\), \(-4\)}, {16, \(-8\), 4}, {16, 0, \(-4\)}, \[IndentingNewLine]{24, \(-4\), 4}, {18, \(-12\), 2}, {6, \(-12\), \(-2\)}, {0, \(-2\), \(-4\)}}}/2; kg11255 = Graph[{{{1, 2}}, {{1, 4}}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}, ER}, {{2, 6}}, {{3, 4}, ER}, {{4, 7}, ER}, {{4, 7}, ER}, {{5, 6}}, {{6, 7}}}, {{{0, 0}}, {{1, 1}}, {{1, \(-1\)}}, {{0, \(-1\)}}, {{\(- .5\), .5}}, {{\(-1\), 1}}, {{\(-1\), \(-1\)}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["\<\ k11255 has same Kaufman and 1-variable Jones as k11257, but different HOMFLY \ (2-variable Jones0, Alexander, and Conway polynomials.\ \>", "Text", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(k11257 = {{{\(-9\), 0, 0}, {\(-6\), 2, \(-2\)}, {\(-3\), 2, 2}, {0, 1, \(-2\)}, {3, 0, 2}, {5, \(-1\), \(-2\)}, {8, \(-4\), 2}, {5, \(-7\), 0}, {\(-2\), \(-7\), 0}, {\(-4\), \(-2\), 4}, \[IndentingNewLine]{\(-3\), 2, 0}, {0, 2, 4}, {0, \(-4\), \(-2\)}, {\(-2\), \(-7\), 2}, {\(-6\), \(-6\), 0}, {\(-7\), \(-2\), \(-2\)}, {\(-6\), 2, 2}, {\(-2\), 5, 0}, {4, 4, \(-2\)}, {5, \(-2\), 2}, \[IndentingNewLine]{2, \(-2\), \(-2\)}, {4, 4, 2}, {8, 2, 0}, {8, \(-3\), \(-2\)}, {0, \(-4\), 2}, {\(-4\), \(-3\), \(-2\)}, {\(-7\), \(-2\), 2}, {\(-9\), 0, 0}}}; kg11257 = Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}}, {{1, 4}, ER}, {{1, 7}, ER}, {{2, 5}}, {{2, 6}}, {{3, 4}}, {{4, 5}, ER}, {{5, 6}, ER}, {{6, 7}, ER}}, {{{\(-1\), 0}}, {{0, 0}}, {{0, 1}}, {{\(-1\), 2}}, {{1, 2}}, {{1, 0}}, {{0, \(-1\)}}}];\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ RowBox[{\( (*\ k11255\ polynomials*) \), "\[IndentingNewLine]", RowBox[{\(pr = \(-1\); crosscurv[k11255]\), "\[IndentingNewLine]", \(p11255 = nodeListToPword[nodeList]\), "\[IndentingNewLine]", StyleBox[\(KauffmanPolynomial[p11255]\), FontWeight->"Bold"], StyleBox["\[IndentingNewLine]", FontWeight->"Bold"], \(SkeinPolynomial[0, p11255]\), "\[IndentingNewLine]", \(SkeinPolynomial[1, p11255]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-1\), p11255]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-2\), p11255]\)}]}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{\( (*\ k11257\ polynomials*) \), "\[IndentingNewLine]", RowBox[{\(crosscurv[k11257]\), "\[IndentingNewLine]", \(p11257 = nodeListToPword[nodeList]\), "\[IndentingNewLine]", StyleBox[\(KauffmanPolynomial[p11257]\), FontWeight->"Bold"], StyleBox["\[IndentingNewLine]", FontWeight->"Bold"], \(SkeinPolynomial[0, p11257]\), "\[IndentingNewLine]", \(SkeinPolynomial[1, p11257]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-1\), p11257]\), "\[IndentingNewLine]", \(SkeinPolynomial[\(-2\), p11257]\)}]}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(kg11con = Graph[{{{1, 2}, ER}, {{1, 4}}, {{1, 7}}, {{1, 8}, ER}, {{2, 3}, ER}, {{3, 4}}, {{3, 5}, ER}, {{4, 5}}, {{5, 6}}, {{5, 8}, ER}, {{6, 7}}}, {{{0, \(-2\)}}, {{\(-2\), \(-1\)}}, {{\(-2\), 1}}, {{\(-1\), 0}}, {{0, 2}}, {{2, 1}}, {{2, \(-1\)}}, {{1, 0}}}];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["6.6. Braids", "Subsection"], Cell[BoxData[{ \(\(b03001 = {1, 1, 1} (*Conway\ Notation\ 3*) ;\)\), "\n", \(\(b04001 = {2, \(-1\), 2, \(-1\)} (*Conway\ Notation\ 22*) ;\)\), "\n", \(\(b05001 = {1, 1, 1, 1, 1} (*Conway\ Notation\ 5*) ;\)\)}], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(b06001 = {3, \(-2\), 3, \(-1\), 2, \(-1\), 2} (*42*) ; b06002 = {2, 2, 2, \(-1\), 2, \(-1\)} (*312*) ; b06003 = {2, 2, \(-1\), \(-1\), 2, \(-1\)} (*2112*) ; b06c33 = {2, 2, 2, \(-1\), \(-1\), \(-1\)};\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Show[ GraphicsArray[{{Show[curvs[ringBraid[b06001], chordno \[Rule] 3], DI, V003], Show[curvs[ringBraid[b06002], chordno \[Rule] 3], DI, V003]}, {Show[curvs[ringBraid[b06003], chordno \[Rule] 3], DI, V003], Show[curvs[ringBraid[b06c33], chordno \[Rule] 3], DI, V003]}}]];\)\)], "Input", PageWidth->PaperWidth, FontSize->9], Cell["Some 7-braids for analysis:-", "Text", FontSize->9], Cell[BoxData[ \(\(b07a = {{3, 3, 3, 1, 1, 1, \(-2\)}, {3, 3, 3, 1, \(-2\), 1, \(-2\)}, {3, 3, 3, \(-2\), 1, \(-2\), 1}, {3, 3, 1, 3, \(-2\), 1, \(-2\)}, {3, 3, 1, \(-2\), 3, 1, \(-2\)}, {3, 3, 1, \(-2\), 1, 3, \(-2\)}, {3, 3, \(-2\), 3, 1, \(-2\), 1}, {3, 1, \(-2\), 3, 1, 1, \(-2\)}, {3, \(-2\), 3, 1, 1, 1, \(-2\)}, {3, \(-2\), 3, 1, 1, \(-2\), 1}, {3, \(-2\), 3, 1, \(-2\), 3, 1}, {3, \(-2\), 3, 1, \(-2\), 1, 1}, {3, \(-2\), 3, 1, \(-2\), 1, \(-2\)}, {3, \(-2\), 3, \(-2\), 1, \(-2\), 1}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Show[ GraphicsArray[\[IndentingNewLine]{{Show[ curvs[braid[b07a[\([1]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([2]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07a[\([3]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([4]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07a[\([5]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([6]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07a[\([7]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([8]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07a[\([9]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([10]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07a[\([11]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([12]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07a[\([13]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07a[\([14]\)]], rad \[Rule] .2], DI, V003]}}]];\)\)], "Input", PageWidth->PaperWidth, FontSize->9], Cell["\<\ Braids for 7-crossing knots, found by Alexander's technique. The longer ones \ may not be minimal.\ \>", "Text", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(\(b07 = {{1, 1, 1, 1, 1, 1, 1} (*7*) , {3, 3, 1, 2, 1, \(-3\), 1, 2, 2} (*52*) , {2, 2, 1, 1, 1, 1, \(-2\), 1} (*52*) , {3, 3, 2, \(-3\), 1, \(-2\), 1, 2, 2} (*313*) , {2, 2, 2, 2, 1, 1, \(-2\), 1} (*322*) , {3, \(-2\), 1, 1, 2, 3, 3, \(-1\), \(-2\)}, {3, \(-2\), 1, \(-2\), 3, \(-2\), \(-1\), 3, \(-2\)} (*21112*) , {3, 3, 3, 2, \(-1\), 2, \(-1\)} (*3 #4*) };\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Show[ GraphicsArray[\[IndentingNewLine]{{Show[ curvs[braid[b07[\([1]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07[\([2]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07[\([3]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07[\([4]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07[\([5]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07[\([6]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b07[\([7]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b07[\([8]\)]], rad \[Rule] .2], DI, V003]}}]];\)\)], "Input", PageWidth->PaperWidth, FontSize->9], Cell["\<\ Braids for 8-crossing knots, found by Alexander's technique. The longer ones \ are not guaranteed to be be minimal.\ \>", "Text", PageWidth->PaperWidth, FontSize->9], Cell[BoxData[ \(\(b08 = {{4, 1, \(-2\), \(-3\), 4, \(-1\), \(-1\), 2, \(-3\), \(-2\)} (*1\ \ 62*) , {2, 2, 2, 2, 2, \(-1\), 2, \(-1\)} (*2\ \ 512*) , {4, 4, \(-2\), 3, \(-4\), \(-2\), \(-1\), 2, 3, \(-1\)} (*3\ \ 44*) , {3, 3, 3, \(-2\), \(-1\), 2, 3, \(-1\), \(-2\)} (*4\ \ 413*) , {2, 2, 2, \(-1\), 2, 2, 2, \(-1\)} (*5\ \ 3, 3, 2*) , {2, 2, 2, \(-1\), 2, 2, 1, 1} (*6\ \ 332*) , {2, 2, 2, 2, \(-1\), 2, \(-1\), \(-1\)} (*7\ \ 4112*) , {3, 3, \(-1\), \(-2\), 3, 3, 1, \(-2\), \(-3\), \(-1\), \(-1\)} (*8\ \ 2312*) , {2, 2, 1, \(-2\), \(-2\), 1, \(-2\), \(-1\), 2, \(-1\)} (*9\ \ 3113*) , {2, 2, 2, \(-1\), \(-1\), 2, 2, \(-1\)} (*10\ \ 3, 21, 2*) , \[IndentingNewLine]{3, 3, 2, \(-3\), 2, \(-1\), 2, \(-1\), 2} (*11\ \ 3212*) , {4, 2, \(-3\), 4, \(-1\), 2, \(-3\), \(-1\)} (*12\ \ 2222*) , {3, 3, \(-1\), \(-1\), 2, \(-3\), 2, \(-1\), 2} (*13\ \ 31112*) , {4, 4, \(-3\), 4, 2, 3, \(-1\), 2, 3, \(-1\)} (*14\ \ 22112*) , {3, 1, 2, 2, 2, \(-3\), 1, \(-2\), 1} (*15\ \ 21, 21, 2*) , {2, 2, \(-1\), 2, 2, \(-1\), 2, \(-1\)} (*16\ \ .2 .20*) , {2, 2, \(-1\), \(-1\), 2, \(-1\), 2, \(-1\)} (*17\ \ .2 .2*) , {2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\)} (*18\ \ 8*\ *) , {2, 2, 1, \(-2\), 1, 1, 2, 1} (*19\ \ 3, 3, \(\(2\)\(-\)\)*) , {2, 2, \(-1\), \(-2\), \(-2\), 1, \(-2\), \(-1\)} (*20\ \ 3, 21, \(\(3\)\(-\)\)*) , {2, 2, 1, 1, \(-2\), 1, 2, \(-1\)} (*21\ \ 21, 21, \(\(2\)\(-\)\)*) };\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(Show[ GraphicsArray[{{Show[curvs[braid[b08[\([1]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([2]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([3]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b08[\([4]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([5]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([6]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b08[\([7]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([8]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([9]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b08[\([10]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([11]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([12]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b08[\([13]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([14]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([15]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b08[\([16]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([17]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([18]\)]], rad \[Rule] .2], DI, V003]}, {Show[curvs[braid[b08[\([19]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([20]\)]], rad \[Rule] .2], DI, V003], Show[curvs[braid[b08[\([21]\)]], rad \[Rule] .2], DI, V003]}}]];\)\)], "Input", PageWidth->PaperWidth, FontSize->9], Cell["Dihedral Symmetry Braids:-", "Text", FontSize->9], Cell[BoxData[ \(bD8 = {2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\)}; (*8\_18*) \[IndentingNewLine]bD10 = {2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\)}; bD14 = {2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\)}; bD16 = {2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\)};\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["A few 9 node braids, mainly unidentified.", "Text", FontSize->9], Cell[BoxData[{ \(\(b09001 = {1, 1, 1, 1, 1, 1, 1, 1, 1} (*\ 9\ *) ;\)\), "\[IndentingNewLine]", \(\(b09004 = {3, 3, 3, 3, 3, 1, 1, 2, \(-3\), \(-1\), 2} (*\ 54\ *) ;\)\), "\[IndentingNewLine]", \(\(b09010 = {3, \(-2\), \(-2\)\ , \(-1\), 2, \(-1\), \(-2\), \(-2\), \ \(-3\), \(-3\), \(-2\)} (*333*) ;\)\), \ "\[IndentingNewLine]", \(\(b09023 = {3, 3, 2, \(-1\), 2, \(-3\), \(-1\), 2, 2} (*22122*) ;\)\), "\[IndentingNewLine]", \(\(b09031 = {3, 2, 3, 1, 2, \(-3\), \(-1\), \(-2\), \(-2\)} (*2111112*) ;\)\), "\ \[IndentingNewLine]", \(\(b09040 = {3, 1, \(-2\), 3, 1, \(-2\), 3, 1, \(-2\)} (*\ \(9\)\(*\)\ *) ;\)\), "\[IndentingNewLine]", \(\(b09041 = {4, \(-1\), 2, \(-3\), 1, 4, 1, \(-2\), \(-2\), 3, \(-2\), 3} (*\ 20 : \(20 : 20\)\ *) ;\)\), "\[IndentingNewLine]", \(\(b090042 = {3, \(-2\), \(-1\), \(-2\), 3, 2, \(-1\), \(-2\), \(-1\)} (*\ 22, 3, \(\(2\)\(-\)\)\ *) ;\)\), "\[IndentingNewLine]", \(b0900a = {3, 1, \(-2\), 1, 3, \(-2\), 1, 3, \(-2\)}; b0900b = {3, 3, 3, 1, \(-2\), 3, 1, 3, \(-2\)}; b0900c = {3, 3, 3, 1, 3, \(-2\), 3, 1, \(-2\)}; b0900d = {3, 3, 3, 1, 3, 3, \(-2\), 1, \(-2\)}; b0900e = {3, 3, 3, 3, 3, 1, \(-2\), 1, \(-2\)}; b0900f = {3, 3, \(-2\), 3, \(-2\), 1, \(-2\), 1, \(-2\)}; b0900g = {3, 3, 3, 3, 1, \(-2\), 3, 1, \(-2\)}; b0900h = {3, 3, 1, \(-2\), 3, \(-2\), \(-2\), 1, \(-2\)}; b0900i = {3, 1, 1, 3, 1, \(-2\), 3, 1, \(-2\)}; b0900j = {3, \(-2\), 3, 1, \(-2\), 3, 1, \(-2\), 1};\)}], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell["Larger Braids that need analysing:-", "Text", FontSize->9], Cell[BoxData[ \(\(\(\(b10161 = {2, 2, 2, 1, 1, 2, 2, 1, 1, 1};\)\n \(b1000a = {2, 2, 2, 2, 2, 2, 2, \(-1\), \(-1\), \(-1\)};\)\n b1000b = {2, 2, 2, 2, 2, \(-1\), \(-1\), \(-1\), \(-1\), \(-1\)}; b1000c = {2, \(-1\), 2, \(-1\), \(-1\), \(-1\), \(-1\), \(-1\), \(-1\), \(-1\)}; b1000d = {4, \(-1\), \(-3\), \(-1\), 4, \(-1\), 2, \(-3\), \(-1\), 2}; b1000e = {4, 4, 2, 4, \(-1\), 2, \(-3\), 4, \(-3\), \(-1\)}; b11con = {3, \(-2\), \(-2\), \(-2\), \(-1\), 3, 2, 2, \(-1\), 2, \(-1\)};\)\( (*Conway' s\ knot\ from\ mathworld\ \(\(braidword\)\(.\)\)*) \)\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "6.7. Transcription of Weisstein's LinkData as ", StyleBox["genKnot", FontSlant->"Italic"], " ." }], "Subsection", PageWidth->PaperWidth], Cell["\<\ This section is based on [8], Eric Weisstein's package Knots.m (2003 \ revision), which contains a database of all simple knots and links with up to \ 10 crossings, but which excluded plotting, knot graphs, and knot analysis. \ Part of the knot database is transcribed below, with a revised format, \ omitting the 10-crossing data. Plot and Graph data have been added. Still \ under development! It duplicates and extends the knot data in the rest of \ section 6. (The K2K database contains braid and knot data for 10-14 \ crossings.)\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(toBl[i_, j_] := (*Converts\ Knot . m\ braidwords\ to\ braidlists*) Module[{a, b = genKnot[\([i, j, 9]\)], res = {}, s}, Print[b]; Do[a = b[\([k]\)]; If[Length[a] \[Equal] 0, AppendTo[res, a], s = Sign[a[\([2]\)]]; Do[AppendTo[res, s\ a[\([1]\)]], {t, Abs[a[\([2]\)]]}]], {k, Length[b]}]; reducedBraidList[res]];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(genKnot = Table[{}, {i, 9}];\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(\(genKnot[\([3]\)] = { (*3, 1*) {0, {1}}, \(-{1, \(-1\)}\), "\", "\<3\>", 0, {1, 1, 1}, kn[3], Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}}}, {{{\(-1\), 0}}, {{1, 0}}, {{0, 1}}}], {{0, \ {{\(-2\), 2}, {\(-1\), 4}}}, \ {2, {{1, 2}}}}, {\(-3\), 2, 2}, {{0, {{\(-2\), 2}, {\(-1\), 4}}}, {1, {{1, 3}, {1, 5}}}, {2, {{1, 2}, {1, 4}}}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(genKnot[\([4]\)] = { (*4, 1*) {{\(-2\), {\(-1\)}}, {3, \(-1\)}, "\", "\<22\>", 2.02988321, {2, \(-1\), 2, \(-1\)}, {{{1, 0, 0}, {2, 2, 1}, {0, 3, 2}, {0, 1, 0}, {1, 0, 2}, {0, \(-1\), 1}, {\(-1\), 0, 0}, {0, 1, 2}, {0, 3, 0}, {\(-2\), 2, 1}, {\(-1\), 0, 2}, {1, 0, 0}}}, Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}, ER}, {{2, 3}, ER}}, {{{0, 1}}, {{1, 0}}, {{\(-1\), 0}}}], {{0, {{\(-1\), \(-2\)}, \(-1\), {\(-1\), 2}}}, {2, {1}}}, {\(-3\), \(-2\), 4, 2}, {{0, {{\(-1\), \(-2\)}, \(-1\), {\(-1\), 2}}}, {1, {{\(-1\), \(-1\)}, {\(-1\), 1}}}, {2, \(-1\), 2, \(-1\)}, {3, {{1, \(-1\)}, 1}}}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(genKnot[\([5]\)] = { (*5, 1*) {{0, {1, 1, 0, 1}}, {1, \(-1\), \(+1\)}, "\", "\<5\>", 0, {1, 1, 1, 1, 1}, kn[5], Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 1}}}, {{{0, 0}}, {{1, 0}}, {{ .9, .5}}, {{1, 1}}, {{0, 1}}}], {{0, {{3, 4}, {2, 6}}}, {2, {{\(-4\), 4}, {\(-1\), 6}}}, {4, {{1, 4}}}}, {5, \(-2\), \(-6\), 2, 2}, {{0, {{3, 4}, {2, 6}}}, {1, {{\(-2\), 5}, {\(-1\), 7}, {1, 9}}}, {2, {{\(-4\), 4}, {\(-3\), 6}, {1, 8}}}, {3, {{1, 5}, {1, 7}}}, {4, {{1, 4}, {1, 6}}}}}, \[IndentingNewLine] (*5, 2*) {{0, {1, 0, 1}}, \(-{3, \(-2\)}\), "\", "\<32\>", 2.8281220, {2, 2, \(-1\), 2, 1, 1}, {{{0, 3, 1}, {0, 2, \(-1\)}, {1, 1, 1}, {1, 0, 0}, {0, 0, \(-1\)}, {\(-1\), 1, 1}, {\(-1\), 2.5, 0}, {0, 3, \(-1\)}, {0, 2, 1}, {\(-1\), 1, \(-1\)}, {\(-1\), 0, 0}, {0, 0, 1}, {1, 1, \(-1\)}, {1, 2.5, 0}, {0, 3, 1}}}, Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{3, 4}}, {{4, 1}}}, {{{0, 1}}, {{1, 1}}, {{1, 0}}, {{0, 0}}}], {{0, {{\(-1\), 2}, {1, 4}, {1, 6}}}, {2, {{1, 2}, {\(-1\), 4}}}}, {1, \(-4\), \(-2\), 4, 2}, {{0, {{\(-1\), 2}, {1, 4}, {1, 6}}}, {1, {{\(-2\), 5}, {\(-2\), 7}}}, {2, {{1, 2}, {\(-1\), 4}, {\(-2\), 6}}}, {3, {{1, 3}, {2, 5}, {1, 7}}}, {4, {{1, 4}, {1, 6}}}}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(genKnot[\([6]\)] = { (*6, 1*) {{\(-2\), {\(-1\), 0, \(-1\)}}, {5, \(-2\)}, "\", "\<42\>", 3.16396322, {3, 2, \(-1\), 2, 3, \(-1\), \(-2\)}, {{{0, \(- .55\), 0}, {1, 0, 1}, {2, 2, \(-1\)}, {2, 4, 0}, {0, 4, 1}, {\(-1\), 3, 0}, {0, 2, \(-1\)}, {2, 1, 1}, {2.5, .2, 0}, {1, 0, \(-1\)}, {0, 0, 0}, {\(-1\), 0, 1}, {\(-2.5\), .2, 0}, {\(-2\), 1, \(-1\)}, {0, 2, 1}, {1, 3, 0}, {0, 4, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), 2, 1}, {\(-1\), 0, \(-1\)}, {0, \(- .55\), 0}}}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{1, 5}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, .9}}, {{0, 1}}}], {{0, {{\(-1\), \(-2\)}, {1, 2}, {1, 4}}}, {2, {1, {\(-1\), 2}}}}, {1, 4, \(-6\), \(-4\), 4, 2}, {{0, {{\(-1\), \(-2\)}, {1, 2}, {1, 4}}}, {1, {{2, 1}, {2, 3}}}, {2, {{1, \(-2\)}, {\(-4\), 2}, {\(-3\), 4}}}, {3, {{1, \(-1\)}, {\(-2\), 1}, {\(-3\), 3}}}, {4, {1, {2, 2}, {1, 4}}}, {5, {{1, 1}, {1, 3}}}}}, \[IndentingNewLine] (*6, 2*) {{\(-1\), {\(-1\), 1, \(-1\)}}, \(-{3, \(-3\), \(+1\)}\), "\", "\<312\>", 4.40083251, {2, 2, 2, \(-1\), 2, \(-1\)}, {{{0, 0, \(-1\)}, {\(-2\), 2, 1}, {\(-3\), 5, 0}, {\(-2\), 8, \(-1\)}, {2, 8, 1}, {3, 5, 0}, {2, 2, \(-1\)}, {0, 0, 1}, {\(-2\), \(- .5\), 0}, {\(-2\), 2, \(-1\)}, {0, 5, 1}, {2, 8, \(-1\)}, {0, 10, 0}, {\(-2\), 8, 1}, {0, 5, \(-1\)}, {2, 2, 1}, {2, \(- .5\), 0}, {0, 0, \(-1\)}}}, Graph[{{{1, 2}, ER}, {{2, 3}, ER}, {{3, 4}, ER}, {{4, 1}, ER}, {{4, 5}}, {{3, 5}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{0, 1}}, {{ .5, 1.5}}}], {{0, {2, {2, 2}, {1, 4}}}, {2, {\(-1\), {\(-3\), 2}, {\(-1\), 4}}}, {4, {{1, 2}}}}, {5, \(-2\), \(-10\), 0, 6, 2}, {{0, {2, {2, 2}, {1, 4}}}, {1, {{\(-1\), 3}, {\(-1\), 5}}}, {2, {\(-3\), {\(-6\), 2}, {\(-2\), 4}, {1, 6}}}, {3, {{\(-2\), 1}, {2, 3}}}, {4, {1, {3, 2}, {2, 4}}}, {5, {{1, 1}, {1, 3}}}}}, \[IndentingNewLine] (*6, 3*) {{\(-3\), {1, \(-1\), 1}}, {5, \(-3\), 1}, "\", "\<2112\>", 5.69302109, {2, 2, \(-1\), \(-1\), 2, \(-1\)}, {{{ .8, 1, 1}, {2, .8, \(-1\)}, {2.5, 0, 0}, {1.5, 0, 1}, { .8, 1, \(-1\)}, {0, 2, 1}, {\(-1.5\), 2, 0}, {\(-2\), .8, \(-1\)}, {\(-1.5\), 0, 1}, {0, \(- .3\), 0}, {1.5, 0, \(-1\)}, {2, 1, 1}, {1.5, 2, 0}, {0, 2, \(-1\)}, {\(-2\), .8, 1}, {\(-2.5\), 0, 0}, {\(-1.5\), 0, \(-1\)}, { .8, 1, 1}}}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{2, 3}}}, {{{0, 0}}, {{0, 1}}, {{1, 0}}}], {{0, {{1, \(-2\)}, 3, {1, 2}}}, {2, {{\(-1\), \(-2\)}, \(-3\), {\(-1\), 2}}}, {4, {1}}}, {5, \(-6\), \(-12\), 4, 8, 2}, {{0, {{1, \(-2\)}, 3, {1, 2}}}, {1, {{\(-1\), \(-3\)}, {\(-2\), \(-1\)}, {\(-2\ \), 1}, {\(-1\), 3}}}, {2, {{\(-3\), \(-2\)}, \(-6\), {\(-3\), 2}}}, {3, {{1, \(-3\)}, {1, \(-1\)}, {1, 1}, {1, 2}}}, {4, {{2, \(-2\)}, 4, {2, 2}}}, {5, {{1, \(-1\)}, {1, 1}}}}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(genKnot[\([7]\)] = { (*7, 1*) {{0, {1, 1, 1, 1, 1, 0, 1}}, \(-{1, \(-1\), \(+1\), \(-1\)}\), "\", "\<7\>", 0, {1, 1, 1, 1, 1, 1, 1}, kn[7], Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 7}}, {{7, 1}}}, {{{0, 0}}, {{ .5, .1}}, {{1, 0}}, {{ .9, .5}}, {{1, 1}}, {{0, 1}}, {{ .1, .5}}, {{1, 1}}}], {{0, {{\(-4\), 6}, {\(-3\), 8}}}, {2, {{10, 6}, {4, 8}}}, {4, {{\(-6\), 6}, {\(-1\), 8}}}, {6, {{1, 6}}}}, {\(-7\), 4, 16, \(-6\), \(-10\), 2, 2}, {{0, {{\(-4\), 6}, {\(-3\), 8}}}, {1, {{3, 7}, {1, 9}, {\(-1\), 11}, {1, 13}}}, {2, {{10, 6}, {7, 8}, {\(-2\), 10}, {1, 12}}}, {3, {{\(-4\), 7}, {\(-3\), 9}, {1, 11}}}, {4, {{\(-6\), 6}, {\(-5\), 8}, {1, 10}}}, {5, {{1, 7}, {1, 9}}}, {6, {{1, 6}, {1, 8}}}}}, \[IndentingNewLine] (*7, 2*) {{0, {1, 0, 1, 0, 1}}, \(-{5, \(-3\)}\), "\", "\<52\>", 3.33174423, {3, 3, 3, 2, \(-3\), 1, 1, 2, \(-1\)}, {{{0, 2, \(-1\)}, {\(- .2\), 3, 1}, {1, 3, 0}, { .75, 1.5, \(-1\)}, { .75, .5, 1}, {1, \(- .5\), 0}, {0, \(- .5\), \(-1\)}, {\(-1\), .5, 1}, {\(-1\), 1.5, \(-1\)}, {0, 2, 1}, { .2, 3, \(-1\)}, {\(-1\), 3, 0}, {\(- .75\), 1.5, 1}, {\(- .75\), .5, \(-1\)}, {\(-1\), \(- .5\), 0}, {0, \(- .5\), 1}, {1, .5, \(-1\)}, {1, 1.5, 1}, {0, 2, \(-1\)}}}, Graph[{{{1, 2}}, {{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 1}}}, {{{0, 0}}, {{1, 0}}, {{ .9, .5}}, {{1, 1}}, {{0, 1}}, {{ .1, .5}}, {{1, 1}}}], {{0, {{\(-1\), 2}, {\(-1\), 6}, {\(-1\), 8}}}, {2, {{1, 2}, {\(-1\), 4}, {1, 6}}}}, {\(-3\), 6, 8, \(-10\), \(-6\), 4, 2}, {{0, {{\(-1\), 2}, {\(-1\), 6}, {\(-1\), 8}}}, {1, {{3, 7}, {3, 9}}}, {2, {{1, 2}, {3, 6}, {4, 8}}}, {3, {{1, 3}, {\(-1\), 5}, {\(-6\), 7}, {\(-4\), 9}}}, {4, {{1, 4}, {\(-3\), 6}, {\(-4\), 8}}}, {5, {{1, 5}, {2, 7}, {1, 9}}}, {6, {{1, 6}, {1, 8}}}}}, \[IndentingNewLine] (*7, 3*) {{0, {1, 1, 0, 2, 0, 1}}, {3, \(-3\), \(+2\)}, "\", "\<43\>", 4.59212569, {2, 2, 2, 2, 1, 1, 2, \(-1\)}, {{{2.75, 2, \(-1\)}, {4, 6, 1}, {5, 15, 0}, {0, 16, \(-1\)}, {\(-2\), 14, 0}, {0, 12, 1}, {2, 10, 0}, {0, 8, \(-1\)}, {\(-4\), 6.5, 1}, {\(-6\), 4, 0}, {\(-2.75\), 2, \(-1\)}, {0, 1.5, 0}, {2.75, 2, 1}, {6, 4, 0}, {4, 6.5, \(-1\)}, {0, 8, 1}, {\(-2\), 10, 0}, {0, 12, \(-1\)}, {2, 14, 0}, {0, 16, 1}, {\(-5\), 15, 0}, {\(-4\), 6, \(-1\)}, {\(-2.75\), 2, 1}, {0, \(-1\), 0}, {2.75, 2, \(-1\)}}}, Graph[{{{1, 2}}, {{1, 2}}, {{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 1}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, .9}}, {{0, 1}}, {{1, 1}}}], , {{0, {{\(-2\), 8}, {\(-2\), 6}, {1, 4}}}, {2, {{1, 8}, {3, 6}, {\(-3\), 4}}}, {4, {{\(-1\), 6}, {1, 4}}}}, {\(-3\), 2, 6, \(-6\), \(-4\), 4, 2}, {{0, {{\(-2\), \(-8\)}, {\(-2\), \(-6\)}, {1, \(-4\)}}}, \ {1, {{\(-2\), \(-11\)}, {1, \(-9\)}, {3, \(-7\)}}}, {2, {{\(-1\), \(-10\)}, \ {6, \(-8\)}, {4, \(-6\)}, {\(-3\), \(-4\)}}}, {3, {{1, \(-11\)}, {\(-1\), \ \(-9\)}, {\(-4\), \(-7\)}, {\(-2\), \(-5\)}}}, {4, {{1, \(-10\)}, {\(-3\), \ \(-8\)}, {\(-3\), \(-6\)}, {1, \(-4\)}}}, {5, {{1, \(-9\)}, {2, \(-7\)}, {1, \ \(-5\)}}}, {6, {{1, \(-8\)}, {1, \(-6\)}}}}}, \[IndentingNewLine] (*7, 4*) {{0, {1, 0, 2, 0, 1}}, \(-{7, \(-4\)}\), "\", "\<313\>", 5.13794120, {3, 3, \(-1\), 2, \(-3\), 2, 1, 1, 2}, {{{2, 2, 1}, {4.5, 2.5, 0}, {4, 0, \(-1\)}, {2, \(-2\), 1}, {0, \(-2.5\), 0}, {\(-2\), \(-2\), \(-1\)}, {\(-4\), 0, 1}, {\(-4.5\), 2.5, 0}, {\(-2\), 2, \(-1\)}, {0, 0, 1}, {2, \(-2\), \(-1\)}, {4.5, \(-2.5\), 0}, {4, 0, 1}, {2, 2, \(-1\)}, {0, 2.5, 0}, {\(-2\), 2, 1}, {\(-4\), 0, \(-1\)}, {\(-4.5\), \(-2.5\), 0}, {\(-2\), \(-2\), 1}, {0, 0, \(-1\)}, {2, 2, 1}}}, Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 1}}, {{2, 5}}}, {{{0, 0}}, {{ .5, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, .9}}, {{0, 1}}, {{1, 1}}}], {{0, {{\(-1\), 8}, {2, 4}}}, {2, {{1, 6}, {\(-2\), 4}, {1, 2}}}}, {1, 8, \(-4\), \(-12\), 0, 6, 2}, {{0, {{\(-1\), \(-8\)}, {2, \(-4\)}}}, {1, {{4, \(-9\)}, \ {4, \(-7\)}}}, {2, {{2, \(-8\)}, {\(-3\), \(-6\)}, {\(-4\), \(-4\)}, {1, \(-2\ \)}}}, {3, {{\(-4\), \(-9\)}, {\(-8\), \(-7\)}, {\(-2\), \(-5\)}, {2, \ \(-3\)}}}, {4, {{\(-3\), \(-8\)}, {3, \(-4\)}}}, {5, {{1, \(-9\)}, {3, \ \(-7\)}, {2, \(-5\)}}}, {6, {{1, \(-8\)}, {1, \(-6\)}}}}}, \ \[IndentingNewLine] (*7, 5*) {{0, {1, 1, 0, 2, \(-1\), 1}}, {5, \(-4\), \(+2\)}, "\", "\<322\>", 6.44353738, {2, 2, 1, 1, 1, 1, 2, \(-1\)}, {{{0, \(-1\), 1}, {\(-2\), 1, \(-1\)}, {\(-4\), 5, 0}, {\(-2\), 8, 1}, {2, 8, \(-1\)}, {4, 5, 0}, {2, 1, 1}, {0, \(-1\), \(-1\)}, {\(-3\), \(-1\), 0}, {\(-2\), 1, 1}, {0, 3, \(-1\)}, {0, 5, 1}, {\(-2\), 8, \(-1\)}, {0, 10, 0}, {2, 8, 1}, {0, 5, \(-1\)}, {0, 3, 1}, {2, 1, \(-1\)}, {3, \(-1\), 0}, {0, \(-1\), 1}}}, Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{5, 1}}, {{3, 5}}, {{3, 5}}}, {{{0, 0}}, {{1, 0}}, {{1, 1}}, {{ .5, 1.5}}, {{0, 1}}, {{1, 1}}}], , {{0, {{2, 4}, {\(-1\), 8}}}, {2, {{\(-3\), 4}, {2, 6}, {1, 8}}}, {4, {{1, 4}, {\(-1\), 6}}}}, {1, 0, \(-4\), \(-6\), 2, 6, 2}, {{0, {{2, 4}, {\(-1\), 8}}}, {1, {{\(-1\), 5}, {1, 7}, {1, 9}, {\(-1\), 11}}}, {2, {{\(-3\), 4}, {1, 8}, {\(-2\), 10}}}, {3, {{\(-1\), 5}, {\(-4\), 7}, {\(-2\), 9}, {1, 11}}}, {4, {{1, 4}, {\(-1\), 6}, {2, 10}}}, {5, {{1, 5}, {3, 7}, {2, 9}}}, {6, {{1, 6}, {1, 8}}}}}, \[IndentingNewLine] (*7, 6*) {{\(-1\), {\(-1\), 2, \(-1\), 1}}, \(-{7, \(-5\), \(+1\)}\), "\", "\<2212\>", 7.08492595, {3, 1, \(-2\), 3, \(-1\), \(-1\), 2, 2, 2}, {{{0, \(- .5\), \(-1\)}, {\(-2\), 1, 1}, {\(-5\), 3, \(-1\)}, {\(-8\), 2, 0}, {\(-5\), 1, 1}, {\(-2\), 2, \(-1\)}, {0, 4, 1}, {0, 7, \(-1\)}, {\(-4\), 7, 0}, {\(-6\), 2, 1}, {\(-4\), \(-1\), \(-1\)}, {0, 0, 1}, {2, 2, \(-1\)}, {3, 6, 0}, {0, 8, 1}, {\(-1\), 5, \(-1\)}, {2, 1, 1}, {2, \(-1\), 0}, {0, \(- .5\), \(-1\)}}}, Graph[{{{1, 2}, ER}, {{1, 3}, ER}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}, ER}, {{2, 4}, ER}, {{4, 5}}}, {{{1, 1}}, {{1, 0}}, {{1.5, .5}}, {{0, 0}}, {{0, 1}}}], \[IndentingNewLine]{{0, {1, {1, 2}, {2, 4}, {1, 6}}}, {2, {\(-1\), {\(-2\), 2}, {\(-2\), 4}}}, {4, {{1, 2}}}}, {5, 2, \(-12\), \(-10\), 6, 8, 2}, {{0, {1, {1, 2}, {2, 4}, {1, 6}}}, {1, {{1, 1}, {2, 3}, {\(-1\), 7}}}, {2, {\(-2\), {\(-4\), 2}, {\(-4\), 4}, {\(-2\), 6}}}, {3, {{\(-4\), 1}, {\(-6\), 3}, {\(-1\), 5}, {1, 7}}}, {4, {1, {1, 2}, {2, 4}, {2, 6}}}, {5, {{2, 1}, {4, 3}, {2, 5}}}, {6, {{1, 2}, {1, 4}}}}}, \[IndentingNewLine] (*7, 7*) {{\(-3\), {1, \(-2\), 1, \(-1\)}}, {9, \(-5\), \(+1\)}, "\", "\<21112\>", 7.64337517, {3, \(-2\), 3, \(-2\), 1, \(-2\), 3, \(-2\), \(-1\)}, {{{1, 1, \(-1\)}, {2, 0, 1}, {2, \(-2\), 0}, {0, \(-2\), \(-1\)}, {\(-1\), \(-1\), 1}, {\(-1\), 1, \(-1\)}, {0, 2, 1}, {2, 2, 0}, {2, 0, \(-1\)}, {1, \(-1\), 1}, {\(-1\), \(-1\), \(-1\)}, {\(-1.1\), \(-2.2\), 0}, {0, \(-2\), 1}, {1, \(-1\), \(-1\)}, {1, 1, 1}, {0, 2, \(-1\)}, {\(-1.1\), 2.2, 0}, {\(-1\), 1, 1}, {1, 1, \(-1\)}}}, Graph[{{{1, 2}}, {{2, 3}}, {{3, 4}}, {{2, 4}, ER}, {{4, 5}, ER}, {{2, 5}, ER}, {{1, 5}}}, {{{0, 0}}, {{ .5, .1}}, {{1, 0}}, {{1, 1}}, {{0, 1}}}], {{0, {{1, 4}, {2, 2}, 2}}, {2, {{\(-2\), 2}, \(-2\), {\(-1\), \(-2\)}}}, {4, {1}}}, {5, 6, \(-18\), \(-14\), 10, 10, 2}, {{0, {{1, \(-4\)}, {2, \(-2\)}, 2}}, {1, {{2, \(-3\)}, {3, \(-1\)}, {1, 1}}}, {2, {{\(-2\), \(-4\)}, {\(-6\), \(-2\)}, \(-7\), \ {\(-3\), 2}}}, {3, {{\(-4\), \(-3\)}, {\(-8\), \(-1\)}, {\(-3\), 1}, {1, 3}}}, {4, {{1, \(-4\)}, {2, \(-2\)}, 4, {3, 2}}}, {5, {{2, \(-3\)}, {5, \(-1\)}, {3, 1}}}, {6, {{1, \(-2\)}, 1}}}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(genKnot[\([8]\)] = { (*8, 1*) {{\(-2\), {\(-1\), 0, \(-1\), 0, \(-1\)}}, {7, \(-3\)}, "\", "\<62\>", 3.42720524, {4, 3, \(-4\), 2, \(-1\), 2, 3, 4, \(-2\), \(-1\)}, {{{4, 2, 1}, {4, 0, 0}, {2, 0, \(-1\)}, {0, 1, \(-1\)}, {\(-2\), 0, 1}, {\(-4\), 0, 0}, {\(-4\), 2, \(-1\)}, {\(-3\), 4, \(-1\)}, {\(-3\), 8, 1}, {0, 8, \(-1\)}, {1, 7, \(-1\)}, {0, 6, 1}, {\(-3\), 6, \(-1\)}, {\(-5\), 4, 0}, {\(-4\), 2, 1}, {\(-2\), 0, \(-1\)}, {0, \(-1\), 0}, {2, 0, 1}, {4, 2, \(-1\)}, {5, 4, 0}, {3, 6, 1}, {0, 6, \(-1\)}, {\(-1\), 7, 0}, {0, 8, 1}, {3, 8, 0}, {3, 4, \(-1\)}, {4, 2, 1}}}, Graph[{{{1, 2}}, {{1, 6}}, {{2, 3}}, {{3, 4}}, {{4, 5}, ER}, {{4, 5}, ER}, {{5, 7}}, {{6, 7}}}, {{{0, 2}}, {{\(-1\), 2}}, {{\(- .8\), 1}}, {{\(-1\), 0}}, {{1, 0}}, {{1, 2}}, {{ .8, 1}}}], {}, {\(-3\), \(-6\), 14, 12, \(-14\), \(-8\), 4, 2}, {}}, \[IndentingNewLine] (*8, 2*) {{1, {1, \(-1\), 1, \(-1\)}}, {3, \(-3\), \(+3\), \(-1\)}, "\", \ "\<512\>", 4.93524267, {2, 2, 2, 2, 2, \(-1\), 2, \(-1\)}, {{{4, 4, \(-1\)}, {2, 8, 1}, {\(-2\), 8, \(-1\)}, {\(-4\), 4, 1}, {\(-4\), 0, \(-1\)}, {\(-2\), \(-1\), 0}, {0, 0, 1}, {2, 1, 1}, {5, 1, \(-1\)}, {6, 3, 0}, {4, 5, 1}, {0, 6, \(-1\)}, {\(-2\), 8, 1}, {0, 10, 0}, {2, 8, \(-1\)}, {0, 6, 1}, {\(-4\), 5, \(-1\)}, {\(-6\), 3, 0}, {\(-5\), 1, 1}, {\(-2\), 1, 1}, {0, 0, \(-1\)}, {2, \(-1\), 0}, {4, 0, 1}, {4, 4, \(-1\)}}}, Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 7}}, {{2, 3}, ER}, {{3, 4}}, {{4, 5}}, {{5, 6}}, {{6, 7}}}, {{{1, 2}}, {{0, 3}}, {{\(-1\), 2}}, {{\(- .9\), 1}}, {{\(-1\), 0}}, {{1, 0}}, {{ .8, 1}}}], {}, {\(-7\), 0, 22, 2, \(-20\), \(-4\), 6, 2}, {}}, \[IndentingNewLine] (*8, 3*) {{\(-4\), {\(-1\), 0, \(-2\), 0, \(-1\)}}, {9, \(-4\)}, "\", "\<44\>", 5.23868410, {4, 3, \(-4\), \(-2\), 3, \(-1\), 4, \(-1\), \(-2\), 1}, {{{1, 0, 0}, {0, 1, \(-1\)}, {\(-1\), 2, 0}, {0, 3, 1}, {1, 4, 0}, {0, 5, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), \(-1\), 1}, {\(-1\), \(-4\), \(-2\)}, {0, \(-5\), 0}, {1, \(-4\), 1}, {2, \(-1\), 1}, {2, 4, 0}, {0, 5, 1}, {\(-1\), 4, 0}, {0, 3, \(-1\)}, {1, 2, 0}, {0, 1, 1}, {\(-1\), 0, 0}, {0, \(-1\), 0}, {2.5, \(-2\), 2}, {2.5, \(-3\), \(-1\)}, {0, \(-4\), 0}, {\(-2.5\), \(-3\), 1}, {\(-2.5\), \(-2\), \(-2\)}, {0, \(-1\), 1}, {1, 0, 0}}}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{2, 5}}, {{3, 4}}, {{4, 5}}}, {{{\(-1\), 0}}, {{1, 0}}, {{\(-1\), 1}}, {{0, .8}}, {{1, 1}}}], {}, {1, \(-8\), 4, 12, \(-8\), \(-6\), 4, 2}, {}}, \[IndentingNewLine] (*8, 4*) {{\(-3\), {\(-1\), 0, \(-2\), 1, \(-1\)}}, \(-{5, \(-5\), \(+2\)}\), "\", "\<413\>", 5.50048641, {3, 3, \(-1\), 2, \(-1\), \(-3\), \(-1\), \(-1\), 2}, {{{1, 2.5, \(-1\)}, {2.5, 1.5, 0}, {3, \(-1\), 0}, {2, \(-2.5\), 1}, {1, \(-2\), 0}, {1.5, \(-1\), \(-1\)}, {2, 0, 1}, {1, .5, 0}, {0, .5, \(-1\)}, {\(-1\), 0, 1}, {\(- .5\), \(-1\), 1}, {0, \(-2\), \(-1\)}, {\(-1\), \(-3\), 0}, {1, \(-4\), 0}, {2, \(-2.5\), \(-1\)}, \[IndentingNewLine]{1.5, \(-1\), 1}, {1, 0, 0}, {1, 1.5, \(-1\)}, {0, 2.5, 1}, {\(-1.5\), 1, 0}, {\(-1.75\), \(-2\), 0}, {\(-1\), \(-4\), \(-1\)}, {0, \(-3\), 0}, {\(-1\), \(-2\), 1}, {\(- .5\), \(-1\), 0}, {0, 0, 1}, {0, 1.5, 1}, {1, 2.5, \(-1\)}}}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{2, 3}, ER}}, {{{\(-1\), 0}}, {{0, 1}}, {{1, 0}}}], {}, {\(-3\), 2, 14, \(-2\), \(-16\), \(-2\), 6, 2}, {}}, \[IndentingNewLine] (*8, 5*) {{1, {1, \(-2\), 1, \(-1\)}}, {5, \(-4\), \(+3\), \(-1\)}, "\", "\<3,3,2\ \>", 6.99718914, {2, \(-1\), \(-1\), \(-1\), 2, \(-1\), \(-1\), \(-1\)}, {{{0, \(-3\), 1}, {3, \(-3\), \(-1\)}, {2, 0, 1}, {1, 1, 1}, {0, 0, \(-1\)}, {\(-1\), \(-1\), 0}, {\(-2\), 1, 1}, {\(-1\), 4, \(-1\)}, (*\({0, 4, 0}\)\(,\)*) {1, 4, 1}, {2, 1, 1}, {1, \(-1\), 0}, {0, 0, 1}, {\(-1\), 1, 0}, {\(-2\), 0, \(-1\)}, {\(-3\), \(-3\), 1}, {0, \(-3\), 0}, {3, \(-1\), 1}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-3\), \(-1\), \(-1\)}, {0, \(-3\), 1}}}, Graph[{{{1, 2}}, {{1, 7}}, {{2, 3}}, {{2, 6}, ER}, {{3, 4}}, {{4, 5}}, {{5, 6}, ER}, {{5, 7}}}, {{{1, 2}}, {{2, 1}}, {{1, 0}}, {{\(-1\), 0}}, {{\(-2\), 1}}, {{0, .9}}, {{\(-1\), 2}}}], {}, {\(-11\), 14, 26, \(-16\), \(-24\), 2, 8, 2}, {}}, \[IndentingNewLine] (*8, 6*) {{\(-1\), {\(-1\), 1, \(-2\), 1, \(-1\)}}, \(-{7, \(-6\), \(+2\)}\), "\", "\<332\>", 7.47523742, {3, 3, \(-1\), 2, \(-3\), \(-1\), 2, 2, 2}, {{{0, 0, 1}, {1, 1, 0}, {0, 2, \(-1\)}, {\(-1\), 3, 0}, {0, 4, 1}, {1, 5, \(-1\)}, {0, 6.5, 0}, {\(-1\), 5, 0}, {0, 4, \(-1\)}, {1, 3, 0}, {0, 2, 1}, {\(-1\), 1, 0}, {0, 0, \(-1\)}, {1, \(-1\), 1}, {1.5, \(-2.5\), 0}, {0, \(-2\), \(-1\)}, {\(-1\), \(-1\), 1}, {\(-2\), 2, 0}, {\(-1\), 5, \(-1\)}, {1, 5, 1}, {2, 2, 0}, {1, \(-1\), \(-1\)}, {0, \(-2\), 0}, {\(-1.5\), \(-2.5\), \(-1\)}, {\(-1\), \(-1\), \(-1\)}, \ {0, 0, 1}}}, Graph[{{{1, 2}}, {{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}}, {{4, 5}}}, {{{1, 1}}, {{\(-1\), 1}}, {{0, 1.5}}, {{\(-1\), 0}}, {{1, 0}}}], {}, {1, \(-4\), 2, 2, \(-8\), 0, 6, 2}, {}}, \[IndentingNewLine] (*8, 7*) {{\(-2\), {1, \(-1\), 2, \(-1\), 1}}, \(-{5, \(-5\), \(+3\), \(-1\)}\), "\", "\<4112\>", 7.02219658, {2, 2, \(-1\), 2, \(-1\), \(-1\), \(-1\), \(-1\)}, {{{1, \(-1\), \(-1\)}, {3, 2, 2}, {4, 4, 2}, {3, 6, \(-1\)}, {0, 5, 2}, {\(-3\), 5, 2}, {\(-4\), 7, \(-1\)}, {\(-1\), 9, 1}, {2, 7, 2}, {2.5, 5, 1}, {1, 3, \(-1\)}, {\(-4\), 2, 2}, {\(-4\), 0, 1}, {\(-2\), 0, \(-1\)}, {0, 1, 1}, {2, 0, 2}, {4, 1, 1}, {1, 3, 1}, {0, 5, \(-1\)}, {\(-2\), 7, 0}, {\(-4\), 5, 2}, {\(-3\), 2, \(-1\)}, {\(-2\), 0, 2}, {1, \(-1\), \(-1\)}}}, Graph[{{{1, 2}}, {{1, 2}}, {{1, 2}}, {{1, 2}}, {{1, 3}}, {{2, 3}, ER}, {{2, 4}, ER}, {{3, 4}, ER}}, {{{0, 0}}, {{1, 0}}, {{0, 1}}, {{1, 1}}}], {}, {\(-7\), 4, 20, \(-8\), \(-20\), 2, 8, 2}, {}}, \[IndentingNewLine] (*8, 8*) {{\(-3\), {1, \(-1\), 2, \(-1\), 1}}, {9, \(-6\), \(+2\)}, "\", "\<2312\>", 7.801341224, {3, 3, 1, \(-2\), 3, \(-1\), \(-1\), \(-2\), \(-2\)}, {{{1, 0, \(-1\)}, {6, 0, 6}, {6, 5, \(-1\)}, {0, 5, 6}, {\(-4\), 2, \(-2\)}, {0, \(-1\), 2}, {1.5, 5, \(-1\)}, {\(-1\), 9, 6}, {\(-1\), 13, 2}, {4, 12, \(-1\)}, \[IndentingNewLine]{8, 8, 6}, {10, 1, 2}, {6, \(-1\), \(-1\)}, {4, 5, 6}, {8, 9, \(-1\)}, {8, 13, 2}, {4, 13, 6}, {0, 9, \(-1\)}, {\(-2\), 4, 6}, {1, 0, \(-1\)}}}, Graph[{{{1, 2}}, {{1, 4}}, {{2, 3}, ER}, {{2, 4}}, {{2, 4}}, {{2, 4}}, {{3, 4}, ER}, {{3, 4}, ER}}, {{{0, 1}}, {{1, 1}}, {{1, 0}}, {{0, 0}}}], {}, {1, 4, 6, \(-10\), \(-14\), 4, 8, 2}, {}}, \[IndentingNewLine] (*8, 9*) {{\(-4\), {\(-1\), 1, \(-2\), 1, \(-1\)}}, {7, \(-5\), \(+3\), \(-1\)}, "\", \ "\<3113\>", 7.58818022, {2, 2, 2, \(-1\), 2, \(-1\), \(-1\), \(-1\)}, {{{0, 2, 1}, {1, 3, 0}, {2, 2, \(-1\)}, {3, 1, 0}, {4, 2, 1}, {5, 3, 0}, {6, 2, \(-1\)}, {6.5, 1, 0}, {6, 0, 1}, {5, \(-1\), \(-1\)}, {3.5, \(-1\), 0}, {4, 0, 1}, {5, 1, \(-1\)}, {6, 2.5, 1}, {5, 4, 0}, {1, 4, 0}, {0, 2, \(-1\)}, {1, 1, 0}, {2, 2, 1}, {3, 3, 0}, {4, 2, \(-1\)}, {5, 1, 1}, {6, 0, \(-1\)}, {6.5, \(-1\), 0}, {5, \(-1\), 1}, {3.5, 0, \(-1\)}, {1, 0, 0}, {0, 2, 1}}}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}, ER}, {{2, 3}}, {{2, 5}}, {{3, 4}}, {{4, 5}}}, {{{0, 0}}, {{1, 0}}, {{0, 1}}, {{ .5, .9}}, {{1, 1}}}], {}, {\(-7\), 4, 16, \(-10\), \(-16\), 4, 8, 2}, {}}, \[IndentingNewLine] (*8, 10*) {{\(-2\), {1, \(-1\), 3, \(-1\), 1}}, \(-{7, \(-6\), \(+3\), \(-1\)}\), "\", \ "\<3,21,2\>", 8.65114855, {2, 2, 2, \(-1\), 2, 2, \(-1\), \(-1\)}, {{{0, 0, \(-1.5\)}, {1, 1, 1}, {2, 0, 0}, {1, \(-1\), \(-1\)}, {\(- .5\), 0, 1}, {\(-3\), 2, \(-1\)}, {0, 3, 1.5}, {1.2, 1, \(-1\)}, {1.3, \(-1\), 1}, {0, \(-3.5\), \(-1.5\)}, {\(-2.5\), \(-4\), 1}, {\(-1.5\), \(-2.5\), 1}, {\(-1.5\), \(-1\), \(-1\)}, {\(-1.5\), 1.3, 1.5}, {\(-2\), 3, \(-1\)}, {\(-4\), 3, 0}, {\(-4\), \(-1\), 0}, {\(-3\), \(-5\), 0}, {\(-1\), \(-4\), 1. }, {\(-1.5\), \(-2.5\), \(-1.5\)}, {\(-2.5\), \(-1.25\), 1.5}, {0, 0, \(-1.5\)}}}, Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 3}}, {{1, 4}, ER}, {{2, 3}}, {{2, 3}}, {{2, 4}, ER}}, {{{1, 0}}, {{0, 1}}, {{0, 0}}, {{1, 1}}}], {}, {\(-11\), 14, 22, \(-22\), \(-22\), 8, 10, 2}, {}}, \[IndentingNewLine] (*8, 11*) {{\(-1\), {\(-1\), 2, \(-2\), 1, \(-1\)}}, \(-{9, \(-7\), \(+2\)}\), "\", "\<3212\>", 8.28631681, {3, 3, \(-1\), 2, \(-1\), 2, 2, \(-3\), 2}, {{{0, 5, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), 1, 1}, {\(-1\), \(-1\), \(-1\)}, {1, \(-1\), 1}, {2, 1, \(-1\)}, {2, 4, 0}, {0, 5, 1}, {\(-1\), 4, 0}, {0, 3, \(-1\)}, {1, 2, 0}, {0, 1, 1}, {\(-2\), 0, \(-1\)}, {\(-2\), \(-1\), 0}, {\(-1\), \(-1\), 1}, { .5, 0, \(-1\)}, {2, 1, 1}, {2, \(-1\), 0}, {1, \(-1\), \(-1\)}, { .5, 0, 1}, {0, 1, \(-1\)}, {\(-1\), 2, 0}, {0, 3, 1}, {1, 4, 0}, {0, 5, \(-1\)}}}, Graph[{{{1, 2}}, {{1, 5}}, {{1, 5}}, {{1, 5}}, {{2, 3}}, {{3, 4}, ER}, {{3, 5}}, {{4, 5}, ER}}, {{{0, 0}}, {{0, 1}}, {{1, 1}}, {{1.5, .5}}, {{1, 0}}}], {}, {\(-3\), 6, 4, \(-12\), \(-10\), 6, 8, 2}, {}}, \[IndentingNewLine] (*8, 12*) {{\(-4\), {\(-1\), 1, \(-3\), 1, \(-1\)}}, {13, \(-7\), \(+1\)}, "\", "\<2222\>", 8.93585692, {4, \(-3\), 4, \(-2\), 3, \(-1\), 2, \(-1\), 2, \(-3\)}, {{{\(-1\), \(-1\), 1}, {0, 1, \(-1\)}, {1, 2.3, 0}, {\(- .5\), 3, 1}, {\(-2.5\), 3, \(-1\)}, {\(-3.5\), 4, 0}, {\(-2.5\), 5, 1}, {\(- .5\), 5, \(-1\)}, {1, 6, 0}, {0, 7, 1}, {\(-2\), 6.5, 0}, {\(-2.5\), 5, \(-1\)}, {\(-2\), 3, 1}, {\(-1\), 0, \(-1\)}, {0, \(-1\), 0}, {1, 0, 1}, {2, 3, 0}, {2, 6, 0}, {0, 7, \(-1\)}, {\(-1\), 5, 1}, {\(-1\), 3, \(-1\)}, {0, 1, 1}, {1, \(-1\), \(-1\)}, {0, \(-2\), 0}, {\(-1\), \(-1\), 1}}}, Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{1, 5}, ER}, {{2, 4}}, {{2, 4}}, {{2, 5}, ER}, {{3, 4}, ER}}, {{{0, 1}}, {{0, 0}}, {{1, 1}}, {{1, 0}}, {{\(- .5\), .5}}}], {}, {5, 2, \(-8\), \(-12\), \(-4\), 8, 8, 2}, {}}, \[IndentingNewLine] (*8, 13*) {{\(-3\), {1, \(-2\), 2, \(-1\), 1}}, {11, \(-7\), \(+2\)}, "\", "\<31112\>", 8.53123220, {3, \(-2\), 3, 1, 3, \(-2\), \(-1\), \(-1\), \(-2\)}, {{{0, 3, 1}, {2, 3.2, 0}, {1, 2, \(-1\)}, {\(-1\), 2, 1}, {\(-2.5\), 1, \(-1\)}, {\(-2.5\), \(-1\), 0}, {\(-1\), \(-2\), 1}, {1, \(-2\), \(-1\)}, {2.2, \(-1\), 0}, {1.3, 0, 1}, {\(-1.3\), 0, \(-1\)}, {\(-2.5\), 1, 1}, {\(-2\), 3, 0}, {0, 3, \(-1\)}, {1, 2, 1}, {1.3, 0, \(-1\)}, {1, \(-2\), 1}, {0, \(-3\), 0}, {\(-1\), \(-2\), \(-1\)}, {\(-1.3\), 0, 1}, {\(-1\), 2, 0}, {0, 3, 1}}}, Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 5}}, {{1, 6}, ER}, {{2, 3}}, {{2, 6}, ER}, {{3, 4}}, {{4, 5}}}, {{{0, 0}}, {{ .5, 1.3}}, {{0, 2}}, {{1, 2}}, {{1, 0}}, {{ .5, .7}}}], {}, {\(-3\), 10, 10, \(-22\), \(-16\), 10, 10, 2}, {}}, \[IndentingNewLine] (*8, 14*) {{\(-1\), {\(-1\), 2, \(-2\), 2, \(-1\)}}, \(-{11, \(-8\), \(+2\)}\), "\", \ "\<22112\>", 9.21780031, {3, \(-2\), \(-1\), \(-1\), \(-2\), \(-2\), 3, 1, \(-2\)}, {{{0, 0, 1}, {1, \(-1\), \(-1\)}, {2, \(-2\), 1}, {3, \(-1.5\), 0}, {4, 0, \(-1\)}, {3, 1, 0}, {2, 0, 1}, {2, \(-2\), \(-1\)}, {0, \(-2\), 1}, {\(-1\), \(- .5\), \(-1\)}, {\(-1.5\), 1, 0}, {0, 2, 1}, {1, 1, 0}, {0, 0, \(-1\)}, {\(-1\), \(- .5\), 1}, {\(-1.5\), \(-2\), 0}, {0, \(-2\), \(-1\)}, {1, \(-1\), 1}, {2, \(- .5\), \(-1\)}, {3, 0, 1}, {2.5, 2, 0}, {0, 2, \(-1\)}, {0, 0, 1}}}, Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 3}}, {{1, 5}, ER}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 4}, ER}, {{4, 5}, ER}}, {{{0, 0}}, {{2, 1}}, {{2, 0}}, {{1, .9}}, {{0, 1}}}], {}, {1, 8, 0, \(-22\), \(-10\), 12, 10, 2}, {}}, \[IndentingNewLine] (*8, 15*) {{0, {1, 1, 0, 3, \(-2\), 2, \(-1\)}}, {11, \(-8\), \(+3\)}, "\", "\<21,21,2\>", 9.93064829, {3, 2, 2, 3, 1, 1, \(-2\), 3, 1}, {{{0, 1, 1}, {1, 2, 0}, {0, 3, \(-1\)}, {\(-1.5\), 3, 0}, {\(-2\), 1, 1}, {\(-2\), \(-1\), \(-1\)}, {0, \(-2\), 0}, {2, \(-1\), 1}, {2, 1, \(-1\)}, {1.5, 3, 0}, {0, 3, 1}, {\(-1\), 2, 0}, {0, 1, \(-1\)}, {1, 0, 1}, {2, \(-1\), \(-1\)}, {3, 0, 0}, {2, 1, 1}, {1, 0, \(-1\)}, {0, \(-1\), 0}, {\(-1\), 0, 1}, {\(-2\), 1, \(-1\)}, {\(-3\), 0, 0}, {\(-2\), \(-1\), 1}, {\(-1\), 0, \(-1\)}, {0, 1, 1}}}, Graph[{{{1, 2}}, {{1, 3}}, {{1, 5}}, {{1, 5}}, {{2, 3}}, {{3, 4}}, {{3, 5}}, {{4, 5}}}, {{{\(-1\), 0}}, {{\(-1\), 1}}, {{0, .9}}, {{1, 1}}, {{1, 0}}}], {}, {\(-7\), 16, 10, \(-32\), \(-16\), 16, 12, 2}, {}}, \[IndentingNewLine] (*8, 16*) {{\(-2\), {1, \(-2\), 3, \(-2\), 1}}, \(-{9, \(-8\), \(+4\), \(-1\)}\), "\", \ "\<.2.20\>", 10.57902191, {2, \(-1\), 2, \(-1\), \(-1\), 2, \(-1\), \(-1\)}, {{{1, 0, 1}, {2, 2, \(-1\)}, {2, 4, 0}, {0, 4, 1}, {\(-1\), 3, \(-1\)}, {0, 1, 1}, {1, 0, \(-1\)}, {2, 0, 0}, {2, 1, 1}, {1, 2, \(-1\)}, {\(-1\), 2, 1}, {\(-2\), 1, \(-1\)}, {\(-2\), 0, 0}, {\(-1\), 0, 1}, {0, 1, \(-1\)}, {1, 3, 1}, {0, 4, \(-1\)}, {\(-2\), 4, 0}, {\(-2\), 2, 1}, {\(-1\), 0, \(-1\)}, {1, 0, 1}}}, Graph[{{{1, 2}}, {{1, 3}}, {{1, 4}, ER}, {{2, 3}}, {{2, 4}, ER}, {{2, 4}, ER}, {{3, 4}, ER}, {{3, 4}, ER}}, {{{0, 2}}, {{\(-1\), 0}}, {{1, 0}}, {{0, 1}}}], {}, {\(-3\), 10, 18, \(-22\), \(-30\), 8, 16, 4}, {}}, \[IndentingNewLine] (*8, 17*) {{\(-4\), {\(-1\), 2, \(-3\), 2, \(-1\)}}, {11, \(-8\), \(+4\), \(-1\)}, "\", "\<.2.2\ \>", 10.98590760, {2, 2, \(-1\), \(-1\), 2, \(-1\), 2, \(-1\)}, {{{0, 0, 0}, {\(-2\), 2, \(-1\)}, {\(-2\), 4, 1}, {\(-1.5\), 6, \(-1\)}, {0, 8, 1}, {3, 8, 0}, {4, 6, \(-1\)}, {2, 4, 1}, {\(-2\), 4, \(-1\)}, {\(-3\), 5, 0}, {\(-1\), 6, 1}, {1, 6.3, \(-1\)}, {4, 6, 1}, {5, 3.5, 0}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 4, 0}, {\(-3\), 7, 0}, {0, 8, \(-1\)}, {2, 6, 1}, {2, 4, \(-1\)}, {2, 2, 1}, {0, 0, 0}}}, Graph[{{{1, 2}}, {{1, 5}}, {{2, 3}, ER}, {{2, 4}}, {{3, 4}, ER}, {{3, 5}, ER}, {{3, 5}, ER}, {{4, 5}}}, {{{0, 1}}, {{1, 1}}, {{ .5, .5}}, {{1, 0}}, {{0, 0}}}], {}, {\(-3\), 6, 12, \(-20\), \(-24\), 10, 16, 4}, {}}, \[IndentingNewLine] (*8, 18*) {{\(-4\), {\(-1\), 3, \(-3\), 3, \(-1\)}}, {13, \(-10\), \(+5\), \(-1\)}, "\", "\<8^*\ \>", 12.35090620, {2, \(-1\), 2, \(-1\), 2, \(-1\), 2, \(-1\)}, {{{0, \(-2\), \(-1\)}, {\(-2\), 0, 2}, {\(-3\), 3, \(-1\)}, {0, 6, 1}, {3, 3, 2}, {2, 0, \(-1\)}, {0, \(-2\), 2}, {\(-3\), \(-3\), \(-1\)}, {\(-6\), 0, 1}, {\(-3\), 3, 2}, {0, 2, \(-1\)}, {2, 0, 2}, {3, \(-3\), \(-1\)}, {0, \(-6\), 1}, {\(-3\), \(-3\), 2}, {\(-2\), 0, \(-1\)}, {0, 2, 2}, {3, 3, \(-1\)}, {6, 0, 1}, {3, \(-3\), 2}, {0, \(-2\), \(-1\)}}}, Graph[{{{1, 2}}, {{1, 4}, ER}, {{1, 5}}, {{2, 3}}, {{2, 4}, ER}, {{3, 4}, ER}, {{3, 5}}, {{4, 5}, ER}}, {{{0, 0}}, {{0, 1}}, {{1, 1}}, {{ .5, .5}}, {{1, 0}}}], {}, {5, 2, 12, \(-26\), \(-36\), 14, 24, 6}, {}}, \[IndentingNewLine] (*8, 19*) {{0, {1, 1, 1, 1, 1}}, {1, \(+0\), \(-1\), \(+1\)}, "\", "\<3,3,2-\>", 0, {2, 2, 1, 1, 2, 1, 2, 1}, {{{0, 0, 0}, {\(-2\), 2, 1}, {\(-2\), 4, 1}, {\(-1.5\), 6, \(-1\)}, {0, 8, \(-1\)}, {3, 8, 0}, {4, 6, 1}, {2, 4, \(-1\)}, {\(-2\), 4, \(-1\)}, {\(-3\), 5, 0}, {\(-1\), 6, 1}, {1, 6.3, \(-1\)}, {4, 6, \(-1\)}, {5, 3.5, 0}, {2, 2, 1}, {\(-2\), 2, \(-1\)}, {\(-4\), 4, 0}, {\(-3\), 7, 0}, {0, 8, 1}, {2, 6, \(-1\)}, {2, 2, \(-1\)}, {0, 0, 0}}}, Graph[{{{1, 2}}, {{1, 2}}, {{1, 3}}, {{1, 5}}, {{2, 3}}, {{2, 4}}, {{3, 4}}, {{4, 5}}}, {{{0, 0}}, {{1, 0}}, {{ .5, .5}}, {{1, 1}}, {{0, 1}}}], {}, {\(-11\), 10, 20, \(-10\), \(-12\), 2, 2}, {}}, \[IndentingNewLine] (*8, 20*) {{\(-1\), {1, 0, 1}}, {3, \(-2\), \(+1\)}, "\", "\<3,21,2-\>", 4.12490325, {2, 1, 1, 1, 2, \(-1\), \(-1\), \(-1\)}, {{{0, 0, 0}, {\(-2\), 2, \(-1\)}, {\(-2\), 4, 1}, {\(-1.5\), 6, \(-1\)}, {0, 8, 1}, {3, 8, 0}, {4, 6, 1}, {3, 4, \(-1\)}, {\(-2\), 4, \(-1\)}, {\(-3\), 5, 0}, {\(-1\), 6, 1}, {1, 6.3, 1}, {4, 6, \(-1\)}, {5, 3.5, 0}, {2, 2, \(-1\)}, {\(-2\), 2, 1}, {\(-4\), 4, 0}, {\(-3\), 7, 0}, {0, 8, \(-1\)}, {2, 6, \(-1\)}, {2, 2, 1}, {0, 0, 0}}}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 5}}, {{2, 3}}, {{2, 4}}, {{3, 4}, ER}, {{4, 5}}}, {{{0, 0}}, {{1, 0}}, {{ .5, .5}}, {{1, 1}}, {{0, 1}}}], {}, {\(-7\), 12, 12, \(-14\), \(-8\), 4, 2}, {}}, \[IndentingNewLine] (*8, 21*) {{0, {1, \(-1\), 1, \(-1\)}}, \(-{5, \(-4\), \(+1\)}\), "\", "\<21,21,2-\ \>", 6.78371351, {2, 2, 2, 1, \(-2\), \(-2\), 1, 1}, {{{3, \(-1\), \(-1\)}, {1, 1, \(-1\)}, {0, 4, \(-1\)}, {0, 6, 1}, {1, 8, \(-1\)}, {3.1, 8, 0}, {4, 6, \(-1\)}, {2, 4, 1}, {\(-1\), 4, 1}, {\(-2\), 5, 0}, {0, 6, \(-1.5\)}, {4, 6, 1}, {5.5, 4, 0}, {5, 2, \(-1\)}, {4.5, 0, 1}, {7, 0, 0}, {7, 4, 1}, {6, 7, 0}, {3.2, 8, \(-1\)}, {1.3, 6, 1}, {2, 4, \(-1\)}, {6, 1, 1}, {3, \(-1\), \(-1\)}}}, Graph[{{{1, 2}}, {{1, 5}}, {{2, 3}}, {{2, 4}, ER}, {{3, 4}}, {{3, 5}}, {{3, 5}}, {{4, 5}, ER}}, {{{0, 1}}, {{1, 1}}, {{1, 0}}, {{ .5, .5}}, {{0, 0}}}], {}, {\(-7\), 8, 6, \(-12\), \(-2\), 6, 2}, {}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[TextData[{ "Named knot graphs such as kg09008a have more than 9 edges, having been \ obtained via the ", StyleBox["reducedBraidList ", FontSlant->"Italic"], "with more than 9 crossings; they will be replaced by unnamed graphs with 9 \ edges when these are found." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(genKnot[\([9]\)] = { (*9, 1*) {{0, {1, 1, 1, 2, 1, 1, 1, 1, 0, 1}}, {1, \(-1\), \(+1\), \(-1\), \(+1\)}, "\", "\<9\>", 0, {1, 1, 1, 1, 1, 1, 1, 1, 1}, kn[9], , {}, {}, {}}, \n (*9, 2*) {{0, {1, 0, 1, 0, 1, 0, 1}}, \(-{7, \(-4\)}\), "\", "\<72\>", 3.48666014, {4, 4, 4, 3, \(-4\), 2, \(-3\), 1, \(-2\), 1, 2, 3}, {}, , {}, {}, {}}, \n (*9, 3*) {{0, {1, 1, 1, 1, 2, 0, 2, 0, 1}}, \(-{3, \(-3\), \(+3\), \(-2\)}\), "\", "\<63\>", 4.99485640, {2, 2, 1, \(-2\), 1, 1, 1, 1, 1, 1}, {}, , {}, {}, {}}, \n (*9, 4*) {{0, {1, 1, 0, 2, 0, 2, 0, 1}}, {5, \(-5\), \(+3\)}, "\", "\<54\>", 5.55651881, {3, 3, 3, 3, \(-2\), \(-1\), 3, 2, 1, 1, 2}, {}, , {}, {}, {}}, \n (*9, 5*) {{0, {1, 0, 2, 0, 2, 0, 1}}, \(-{11, \(-6\)}\), "\", "\<513\>", 5.69844175, {4, 4, 3, \(-4\), 2, 1, 1, 2, 3, \(-1\), \(-2\), 3, \(-2\), 3}, {}, , {}, {}, {}}, \n (*9, 6*) {{0, {1, 1, 1, 1, 2, \(-1\), 2, \(-1\), 1}}, \(-{5, \(-5\), \(+4\), \(-2\)}\), "\", "\<522\>", 7.20360076, {2, 2, 1, 1, 1, 1, 1, \(-2\), 1, 1}, {}, , {}, {}, {}}, \n (*9, 7*) {{0, {1, 1, 0, 2, \(-1\), 2, \(-1\), 1}}, {9, \(-7\), \(+3\)}, "\", "\<342\>", 8.01486145, {3, 3, \(-1\), 2, 2, 2, \(-3\), 1, 1, 1, 2}, {}, , {}, {}, {}}, \n (*9, 8*) {{\(-3\), {\(-1\), 1, \(-2\), 2, \(-1\), 1}}, \(-{11, \(-8\), \(+2\)}\), "\", "\<2412\>", 8.19234796, {4, 3, 1, \(-2\), 3, \(-4\), \(-1\), \(-1\), 3, \(-2\), 3, 3}, {}, \[IndentingNewLine]Graph[ kg09008a = (*10\ edges*) {{{1, 2}}, {{1, 2}}, {{1, 3}, ER}, {{1, 4}, ER}, {{1, 4}, ER}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 4}, ER}, {{2, 5}}, {{2, 5}}}, {{{0, 1}}, {{\(-1\), 0}}, {{\(- .75\), .75}}, {{\(-1\), 1}}, {{0, 0}}}], {}, {}, {}}, \n (*9, 9*) {{0, {1, 1, 1, 1, 2, \(-1\), 3, \(-1\), 1}}, \(-{7, \(-6\), \(+4\), \(-2\)}\), "\", "\<423\>", 8.01681556, {2, 2, 1, 1, 1, \(-2\), 1, 1, 1, 1}, {}, \(Graph[ kg09009a = (*10\ edges*) {{{1, 2}, ER}, {{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 4}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{3, 4}, ER}}, {{{1, 0}}, {{0, 0}}, {{0, 1}}, {{1, 1}}}];\), {}, {}, {}}, \n (*9, 10*) {{0, {1, 1, 0, 3, \(-1\), 3, 0, 1}}, {9, \(-8\), \(+4\)}, "\", "\<333\>", 8.77345728, {3, 3, \(-1\), 2, 1, 1, 2, 2, 2, \(-3\), 2}, {}, \(Graph[ kg09010a = (*11\ edges*) {{{1, 2}, ER}, {{1, 5}, ER}, {{1, 6}, ER}, {{1, 6}, ER}, {{1, 7}}, {{2, 3}, ER}, {{2, 7}, ER}, {{2, 7}, ER}, {{3, 4}, ER}, {{4, 5}, ER}, {{5, 6}}}, \[IndentingNewLine]{{{0, 1}}, {{0, 0}}, {{2, 0}}, {{2, 2}}, {{0, 2}}, {{1, 1}}, {{1, 0}}}];\), {}, {}, {}}, \n (*9, 11*) {{1, {2, \(-1\), 3, \(-1\), 1}}, {7, \(-7\), \(+5\), \(-1\)}, "\", "\<4122\>", 8.28858904, {3, 2, \(-1\), 2, \(-3\), 2, \(-1\), 2, 2, 2, 2}, {}, Graph[kg09011a = (*11\ edges*) {{{1, 2}, ER}, {{1, 4}, ER}, {{1, 5}}, {{2, 3}}, {{2, 6}, ER}, {{3, 4}, ER}, {{4, 9}, ER}, {{5, 6}}, {{6, 7}, ER}, {{7, 8}, ER}, {{8, 9}, ER}}, {{{2, 1}, V1}, {{2, 0}, V2}, {{3, 1}, V3}, {{2, 2}, V4}, {{1, 1}, V5}, {{1, 0}, V6}, {{0, 0}, V7}, {{0, 1}, V8}, {{0, 2}}, V9}], {}, {}, {}}, \n (*9, 12*) {{\(-1\), {\(-1\), 2, \(-2\), 2, \(-1\), 1}}, \(-{13, \(-9\), \(+2\)}\), "\", "\<4212\>", 8.83664234, {4, 3, \(-4\), 1, \(-2\), 3, \(-1\), \(-1\), 4, 2, 2, 2}, {}, Graph[ kg09012a = (*12\ edges*) {{{1, 2}}, {{1, 5}, ER}, {{1, 6}, ER}, {{1, 8}, ER}, {{2, 3}, ER}, {{2, 6}}, {{2, 6}}, {{2, 7}, ER}, {{3, 4}, ER}, {{3, 5}}, {{4, 5}, ER}, {{7, 8}, ER}}, \[IndentingNewLine]{{{2, 1}, V1}, {{0, 0}, V2}, {{ .5, 1}, V3}, {{ .5, 1.5}, V4}, {{1.5, 1.5}, V5}, {{2, 0}, V6}, {{0, 2}, V7}, {{2, 2}, V8}}], {}, {}, {}}, \n (*9, 13*) {{0, {1, 1, 0, 3, \(-1\), 3, \(-1\), 1}}, {11, \(-9\), \(+4\)}, "\", "\<3213\>", 9.13509403, {3, \(-2\), \(-3\), 1, \(-3\), \(-2\), \(-2\), \(-2\), \(-1\), \(-1\), \(-2\)}, {}, Graph[kg09013a = (*11\ edges*) {{{1, 2}}, {{1, 5}}, {{1, 6}}, {{1, 6}}, {{1, 7}, ER}, {{2, 3}}, {{3, 4}}, {{4, 5}}, {{4, 7}}, {{4, 7}}, {{5, 6}, ER}}, {{{0, 1}, V1}, {{0, 2}, V2}, {{0, 3}, V3}, {{1, 3}, V4}, {{2, 3}, V5}, {{2, 1}, V6}, {{1, 2}, V7}}], {}, {}, {}}, \n (*9, 14*) {{\(-3\), {1, \(-2\), 2, \(-2\), 1, \(-1\)}}, {15, \(-9\), \(+2\)}, "\", "\<41112\>", 8.95498926, {4, 4, \(-3\), 2, \(-3\), 2, \(-3\), \(-4\), \(-1\), 2, 2, 3, \(-2\), 1}, {}, Graph[kg09014a = (*14\ edges*) {{{1, 2}, ER}, {{1, 5}}, {{1, 6}, ER}, {{1, 7}}, {{2, 3}, ER}, {{3, 4}}, {{3, 8}, ER}, {{4, 5}}, {{4, 6}, ER}, {{4, 7}, ER}, {{5, 6}}, {{5, 8}}, {{5, 9}, ER}, {{8, 9}, ER}}, {{{ .5, 1}, V1}, {{1, 2}, V2}, {{1, 3}, V3}, {{1, 0}, V4}, {{0, 0}, V5}, {{ .5, .3}, V6}, {{ .75, 1}, V7}, {{ .5, 3}, V8}, {{0, 3}, V9}}], {}, {}, {}}, \n (*9, 15*) {{\(-1\), {\(-1\), 2, \(-2\), 3, \(-1\), 1}}, \(-{15, \(-10\), \(+2\)}\), "\", "\<2322\>", 9.88549866, {4, 4, 3, 1, \(-2\), 3, 1, 4, \(-2\), \(-3\)}, {}, , {}, {}, {}}, \n (*9, 16*) {{0, {1, 1, 1, 1, 2, \(-2\), 3, \(-2\), 1}}, \(-{9, \(-8\), \(+5\), \(-2\)}\), "\", \ "\<3,3,2+\>", 9.88300696, {2, 2, 2, 2, 1, 1, \(-2\), 1, 1, 1}, {}, , {}, {}, {}}, \n (*9, 17*) {{\(-3\), {\(-1\), 1, \(-3\), 2, \(-2\), 1}}, \(-{9, \(-9\), \(+5\), \(-1\)}\), "\", \ "\<21312\>", 9.47458045, {3, 2, \(-1\), 2, \(-1\), \(-3\), \(-1\), \(-1\), 2, \(-1\), 2}, {}, , {}, {}, {}}, \n (*9, 18*) {{0, {1, 1, 0, 3, \(-2\), 3, \(-1\), 1}}, {13, \(-10\), \(+4\)}, "\", "\<3222\>", 10.05772963, {3, 3, 2, 2, 1, \(-3\), 1, 2, \(-1\), 2, 2}, {}, , {}, {}, {}}, \n (*9, 19*) {{\(-4\), {\(-1\), 1, \(-3\), 2, \(-2\), 1}}, {17, \(-10\), \(+2\)}, "\", "\<23112\>", 10.03254744, {4, 3, \(-2\), 3, \(-4\), \(-2\), 3, \(-1\), \(-1\), \(-2\), 3, 1}, {}, , {}, {}, {}}, \n (*9, 20*) {{1, {2, \(-2\), 3, \(-2\), 1}}, {11, \(-9\), \(+5\), \(-1\)}, "\", "\<31212\>", 9.64430407, {3, \(-2\), \(-2\), \(-2\), \(-1\), \(-2\), \(-2\), 3, \(-2\), 1, \(-2\)}, {}, , {}, {}, {}}, \n (*9, 21*) {{\(-1\), {\(-1\), 3, \(-2\), 3, \(-1\), 1}}, \(-{17, \(-11\), \(+2\)}\), "\", "\<31122\>", 10.18326553, {4, 4, 2, 2, \(-1\), 3, \(-1\), \(-4\), 3, \(-2\), 3, 1}, {}, , {}, {}, {}}, \n (*9, 22*) {{\(-3\), {\(-1\), 1, \(-3\), 3, \(-2\), 1}}, \(-{11, \(-10\), \(+5\), \(-1\)}\), "\", \ "\<211,3,2\>", 10.62072702, {3, 3, 3, \(-2\), 3, \(-1\), \(-2\), 3, \(-2\), 1, \(-2\)}, {}, , {}, {}, {}}, \n (*9, 23*) {{0, {1, 1, 0, 3, \(-2\), 3, \(-2\), 1}}, {15, \(-11\), \(+4\)}, "\", "\<22122\>", 10.61134829, {3, 3, 3, 2, \(-3\), 2, 1, \(-2\), 1, 1, 2}, {}, , {}, {}, {}}, \n (*9, 24*) {{\(-4\), {\(-1\), 2, \(-3\), 3, \(-1\), 1}}, {13, \(-10\), \(+5\), \(-1\)}, "\", "\<3,21,2+\>", 10.83372910, {3, 3, \(-2\), 3, 1, \(-2\), \(-2\), \(-2\), 1}, {}, Graph[{{{1, 2}}, {{1, 4}}, {{1, 5}, ER}, {{1, 6}, ER}, {{2, 3}}, {{3, 4}}, {{4, 5}, ER}, {{4, 5}, ER}, {{4, 6}, ER}}, {{{1, 1}, V1}, {{ .5, 1}, V2}, {{0, 1}, V3}, {{0, 0}, V4}, {{1, 0}, V5}, {{ .5, .5}, V6}}], {}, {}, {}}, \n (*9, 25*) {{\(-1\), {\(-1\), 2, \(-3\), 3, \(-2\), 1}}, \(-{17, \(-12\), \(+3\)}\), "\", "\<22,21,2\>", 11.39030514, {4, 4, 2, 2, \(-3\), \(-1\), \(-4\), 2, \(-1\), \(-3\), 4, 2, 4, 3}, {}, , {}, {}, {}}, \n (*9, 26*) {{\(-2\), {1, \(-2\), 3, \(-3\), 2, \(-1\)}}, \(-{13, \(-11\), \(+5\), \(-1\)}\), "\", "\ \<311112\>", 10.59584051, {3, 2, \(-1\), 2, \(-3\), \(-1\), 2, \(-1\), 2, 2, 2}, {}, , {}, {}, {}}, \n (*9, 27*) {{\(-4\), {\(-1\), 2, \(-3\), 3, \(-2\), 1}}, {15, \(-11\), \(+5\), \(-1\)}, "\", "\<212112\>", 10.99998095, {3, 2, \(-1\), 2, \(-3\), \(-1\), \(-1\), 2, \(-1\), 2, 2}, {}, , {}, {}, {}}, \n (*9, 28*) {{\(-2\), {1, \(-2\), 4, \(-3\), 2, \(-1\)}}, \(-{15, \(-12\), \(+5\), \(-1\)}\), "\", "\ \<21,21,2+\>", 11.56317701, {3, \(-2\), \(-2\), 3, 1, \(-2\), 1, 3, 1}, {}, Graph[{{{1, 2}}, {{1, 3}, ER}, {{1, 4}}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 4}}, {{2, 5}, ER}, {{2, 5}, ER}}, {{{1, 1}, V1}, {{0, 0}, V2}, {{0, 1}, V3}, {{ .3, .7}, V4}, {{1, 0}, V5}}], {}, {}, {}}, \n (*9, 29*) {{\(-3\), {\(-1\), 2, \(-3\), 4, \(-2\), 1}}, \(-{15, \(-12\), \(+5\), \(-1\)}\), "\", \ "\<.2.20.2\>", 12.20585615, {3, \(-2\), \(-2\), 1, \(-2\), 3, \(-2\), 1, \(-2\)}, {}, , {}, {}, {}}, \n (*9, 30*) {{\(-4\), {\(-1\), 2, \(-4\), 3, \(-2\), 1}}, {17, \(-12\), \(+5\), \(-1\)}, "\", \ "\<211,21,2\>", 11.95452696, {3, 3, \(-2\), 3, 1, \(-2\), 3, \(-1\), \(-1\), \(-2\), \(-1\)}, {}, , {}, {}, {}}, \n (*9, \ \(\(31\)\(:=\)\)*) {{\(-2\), {1, \(-2\), 4, \(-3\), 3, \(-1\)}}, \(-{17, \(-13\), \(+5\), \(-1\)}\), "\", "\ \<2111112\>", 11.68631220, {3, \(-2\), \(-2\), 1, \(-2\), \(-3\), 1, \(-2\), 1, \(-2\), \(-2\)}, {}, , {}, {}, {}}, \n (*9, 32*) {{\(-2\), {1, \(-3\), 4, \(-4\), 2, \(-1\)}}, \(-{17, \(-14\), \(+6\), \(-1\)}\), "\", "\ \<.21.20\>", 13.09989984, {3, 2, \(-3\), 2, \(-1\), 2, 3, \(-1\), 2, 3, \(-1\)}, {}, , {}, {}, {}}, \n (*9, 33*) {{\(-4\), {\(-1\), 3, \(-4\), 4, \(-2\), 1}}, {19, \(-14\), \(+6\), \(-1\)}, "\", "\<.21.2\>", 13.28045563, {3, 1, \(-2\), 3, \(-1\), \(-1\), \(-1\), 2, \(-1\), 2, 2}, {}, , {}, {}, {}}, \n (*9, 34*) {{\(-4\), {\(-1\), 3, \(-5\), 4, \(-3\), 1}}, {23, \(-16\), \(+6\), \(-1\)}, "\", "\<8^* 20\>", 14.34458138, {3, \(-2\), 1, \(-2\), 3, 1, \(-2\), 1, \(-2\)}, {}, Graph[{{{1, 2}}, {{1, 4}}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 5}, ER}, {{2, 6}}, {{3, 4}, ER}, {{4, 6}}, {{5, 6}, ER}}, {{{ .5, .5}, V1}, {{0, 0}, V2}, {{0, 1}, V3}, {{1, 1}, V4}, {{ .75, .25}, V5}, {{1, 0}, V6}}], {}, {}, {}}, \n (*9, 35*) {{0, {1, 0, 2, 0, 3, 0, 1}}, \(-{13, \(-7\)}\), "\", "\<3,3,3\>", 7.94057924, {4, \(-3\), 2, 1, 3, 3, \(-4\), \(-2\), 1, 2, 3, 3, 2, \(-3\)}, {}, , {}, {}, {}}, \n (*9, 36*) {{1, {2, \(-2\), 3, \(-1\), 1}}, {9, \(-8\), \(+5\), \(-1\)}, "\", "\<22,3,2\>", 9.88457865, {3, 3, \(-1\), 2, 3, \(-1\), 2, 2, 2, \(-3\), 2}, {}, , {}, {}, {}}, \n (*9, 37*) {{\(-4\), {\(-1\), 1, \(-4\), 2, \(-2\), 1}}, {19, \(-11\), \(+2\)}, "\", "\<3,21,21\>", 10.98944959, {4, \(-2\), 3, \(-2\), 1, \(-2\), 3, \(-2\), 3, 4, \(-1\), \(-3\)}, {}, , {}, {}, {}}, \n (*9, 38*) {{0, {1, 1, 0, 4, \(-3\), 4, \(-2\), 1}}, {19, \(-14\), \(+5\)}, "\", "\<.2.2.2\>", 12.93285870, {3, 3, 2, 2, \(-1\), 2, \(-3\), 2, 1, 1, 2}, {}, , {}, {}, {}}, \n (*9, 39*) {{\(-1\), {\(-1\), 3, \(-3\), 4, \(-2\), 1}}, \(-{21, \(-14\), \(+3\)}\), "\", "\<2:2:20\>", 12.81031000, {4, 2, 3, 3, \(-1\), 2, 2, 3, 4, \(-2\), \(-1\), \(-3\)}, {}, , {}, {}, {}}, \n (*9, 40*) {{\(-2\), {1, \(-4\), 5, \(-5\), 3, \(-1\)}}, \(-{23, \(-18\), \(+7\), \(-1\)}\), "\", "\ \<9^*\>", 15.01834285, {3, \(-2\), 3, 1, \(-2\), 3, 1, \(-2\), 1}, {}, Graph[{{{1, 2}, ER}, {{1, 3}, ER}, {{1, 5}}, {{2, 3}, ER}, {{2, 6}}, {{3, 4}}, {{4, 5}, ER}, {{4, 6}, ER}, {{5, 6}, ER}}, {{{ .5, .3}, V1}, {{0, 0}, V2}, {{1, 0}, V3}, {{1, 1}, V4}, {{ .5, .7}, V5}, {{0, 1}, V6}}], {}, {}, {}}, \n (*9, 41*) {{\(-3\), {1, \(-2\), 3, \(-3\), 2, \(-1\)}}, {19, \(-12\), \(+3\)}, "\", \ "\<20:20:20\>", 12.09893602, {4, \(-3\), \(-2\), 1, 4, \(-2\), \(-2\), \(-3\), 4, 2, 3, \(-1\), \(-2\), \(-3\)}, {}, , {}, {}, {}}, \n (*9, 42*) {{\(-3\), {\(-1\), 0, \(-1\)}}, \(-{1, \(-2\), \(+1\)}\), "\", \ "\<22,3,2-\>", 4.05686022, {3, 1, 1, \(-2\), 3, \(-1\), \(-1\), \(-2\), 1}, {}, Graph[{{{1, 2}}, {{1, 5}, ER}, {{1, 6}}, {{2, 3}}, {{3, 4}, ER}, {{3, 7}}, {{4, 5}, ER}, {{6, 7}, ER}, {{6, 7}, ER}}, {{{2, 0}, V1}, {{ .5, \(- .5\)}, V2}, {{\(-1\), 0}, V3}, {{\(-1\), 1}, V4}, {{2, 1}, V5}, {{1, 0}, V6}, {{0, 0}, V7}}], {{0, {{\(-2\), \(-2\)}, \(-3\), {\(-2\), 2}}}, {2, {{1, \(-2\)}, 4, {1, 2}}}, {4, {\(-1\)}}}, {}, {}}, \n (*9, 43*) {{1, {1, \(-1\), 1}}, {1, \(-2\), \(+3\), \(-1\)}, "\", "\<211,3,2-\>", 5.90408585, {3, \(-2\), 1, \(-2\), \(-3\), 1, 2, 1, 1, 2, 2}, {}, , {}, {}, {}}, \n (*9, 44*) {{\(-2\), {\(-1\), 1, \(-1\), 1}}, {7, \(-4\), \(+1\)}, "\", "\<22,21,2-\>", 7.40676757, {3, 2, 2, \(-3\), \(-1\), 2, 3, \(-1\), \(-2\)}, {}, Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 4}}, {{3, 4}, ER}, {{3, 4}, ER}, {{4, 5}}, {{4, 5}}}, {{{1, 1}, V1}, {{ .5, .5}, V2}, {{1, 0}, V3}, {{0, 0}, V4}, {{0, 1}, V5}}], {}, {}, {}}, \n (*9, 45*) {{0, {1, \(-1\), 2, \(-1\), 1}}, \(-{9, \(-6\), \(+1\)}\), "\", "\<211,21,2-\>", 8.60203116, {3, \(-2\), 1, \(-2\), 3, 1, 2, 2, 2}, {}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}}, {{1, 4}}, {{2, 3}, ER}, {{2, 3}, ER}, {{2, 3}, ER}, {{3, 4}, ER}, {{3, 4}, ER}}, {{{1, 1}, V1}, {{1, 0}, V2}, {{0, 0}, V3}, {{0, 1}, V4}}], {}, {}, {}}, \n (*9, 46*) {{0, {\(-1\), 0, \(-1\)}}, {5, \(-2\)}, "\", "\<3,3,21-\>", 4.75170196, {3, 2, \(-3\), \(-1\), 2, 3, 1, \(-2\), 1}, {}, Graph[{{{1, 2}, ER}, {{1, 3}}, {{1, 5}, ER}, {{2, 3}, ER}, {{2, 6}}, {{3, 4}, ER}, {{4, 5}}, {{4, 6}, ER}, {{5, 6}, ER}}, {{{0, .36}, V1}, {{\(-1\), 0}, V2}, {{1, 0}, V3}, {{1, 1}, V4}, {{0, .7}, V5}, {{\(-1\), 1}, V6}}], {}, {}, {}}, \n (*9, 47*) {{\(-2\), {1, \(-2\), 2, \(-2\)}}, \(-{5, \(-6\), \(+4\), \(-1\)}\), "\", \ "\<8^*-20\>", 10.04995786, {3, 2, \(-1\), 2, 3, \(-1\), 2, \(-1\), 2}, {}, Graph[{{{1, 2}, ER}, {{1, 2}, ER}, {{1, 3}, ER}, {{1, 4}, ER}, {{2, 3}, ER}, {{2, 5}, ER}, {{3, 4}}, {{3, 5}}, {{4, 5}}}, {{{1, 0}, V1}, {{0, 0}, V2}, {{ .5, .5}, V3}, {{1, 1}, V4}, {{0, 1}, V5}}], {}, {}, {}}, \n (*9, 48*) {{\(-1\), {\(-1\), 3, \(-1\), 2}}, \(-{11, \(-7\), \(+1\)}\), "\", "\<21,21,21-\>", 9.53187983, {3, 2, 2, \(-3\), \(-1\), 2, \(-3\), 2, 1, 1, \(-2\)}, {}, , {}, {}, {}}, \n (*9, 49*) {{0, {1, 1, 0, 3, \(-1\), 2}}, {7, \(-6\), \(+3\)}, "\", "\<-20:-20:-20\>", 9.42707362, {3, 2, \(-1\), 2, 2, 3, \(-2\), 1, 1, 2, 2}, {}, , {}, {}, {}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["genKnot ", FontSlant->"Italic"], "demo." }], "Subsubsection", PageWidth->PaperWidth], Cell[BoxData[ \(Show[curvs[genKnot[\([7, 5, 7]\)]], V009]; ShowGraph[genKnot[\([8, 3, 8]\)]];\)], "Input", PageWidth->PaperWidth], Cell["\<\ k09014 is one of 4 9-crossing knots with 14 braid crossings. Reductions are \ needed:-\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(ShowGraph[ Graph[kg09014a = {{{1, 2}, ER}, {{1, 5}}, {{1, 6}, ER}, {{1, 7}}, {{2, 3}, ER}, {{3, 4}}, {{3, 8}, ER}, {{4, 5}}, {{4, 6}, ER}, {{4, 7}, ER}, {{5, 6}}, {{5, 8}}, {{5, 9}, ER}, {{8, 9}, ER}}, {{{ .5, 1}, V1}, {{1, 2}, V2}, {{1, 3}, V3}, {{1, 0}, V4}, {{0, 0}, V5}, {{ .5, .3}, V6}, {{ .75, 1}, V7}, {{ .5, 3}, V8}, {{0, 3}, V9}}]];\)\)], "Input", PageWidth->PaperWidth] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["7. Data for some Links.", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Links are one or more loops. Each starting point should be modified by \ rotation until all crossings (", StyleBox["nodeList", FontSlant->"Italic"], " pairs) are odd-even, to satisfy the Dowker-Thistlethwaite name \ requirements. This has been done for all but ", StyleBox["borrom", FontSlant->"Italic"], "." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(liss = {{{0, \ 0, \ 0}, \ {1, \(-1\), \ 0}, \ {2, \ 0, \ 0}, \ {3, 1, \ 1/3}, \ {3, \(-1\), 2/3}, \ {2, \ 0, \ 1}, \ {1, 1, \ 1}, \ {0, \ 0, \ 1}, \ {\(-1\), \(-1\), \ 2/3}, \ {\(-1\), \ 1, \ 1/3}, {0, \ 0, \ 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(liss2 = {\ {{1, \ 1, \ 1}, \ {0, \ 0, \ 1}, \ {\(-1\), \(-1\), 1}, {\(-2\), 1, 1}, {\(-2\), \(-1\), 1/2}, \ {\(-1\), \ 1, \ 1/3}, {0, \ 0, \ 0}, \ {1, \(-1\), \ 0}, {2, \ 0, \ 0}, \ {3, \ 1, \ 1/3}, {3, \(-1\), 2/3}, \ {2, \ 0, \ 1}, \ {1, \ 1, \ 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(eight = {{{0, \ 0, \ 0}, \ {1, \(-1\), \ 1/3}, \ {1, \ 1, \ 2/3}, \ {0, \ 0, \ 1}, \ {\(-1\), \(-1\), \ 2/3}, \ {\(-1\), \ 1, \ 1/3}, {0, \ 0, \ 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unlinks = \ {{{0, \ 0, \ 0}, \ {1, \ 1, \ 0}, \ {0, \ 2, \ 0}, \ {\(-1\), \ 1, \ 0}, {0, \ 0, \ 0}}, \ {\ {1, \ 2, \ 1}, {0, \ 1, \ 1}, \ {1, 0, \ 1}, \ {2, \ 1, \ 1}, {1, \ 2, \ 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(links88 = {{{0, \(-2\), \(-1\)}, {0, \(-1\), 1}, {\(-1\), 0, \(-1\)}, {\(-2\), 1, \(- .75\)}, {\(-2\), 2, 0}, {0, 2, 1}, {0, 1, \(-1\)}, {\(-1\), 0, 1}, {\(-2\), \(-1\), .75}, {\(-2\), \(-2\), 0}, {0, \(-2\), \(-1\)}}, {{2, 1, .75}, {2, 2, 0}, {0, 2, \(-1\)}, {0, 1, 1}, {1, 0, \(-1\)}, {2, \(-1\), \(- .75\)}, {2, \(-2\), 0}, {0, \(-2\), 1}, {0, \(-1\), \(-1\)}, {1, 0, 1}, {2, 1, .75}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(links888 = {{{ .5, \(-2\), \(-1\)}, { .5, \(-1\), 1}, {\(- .5\), 0, \(-1\)}, {\(-1.5\), 1, \(- .75\)}, {\(-1.5\), 2, 0}, { .5, 2, 1}, { .5, 1, \(-1\)}, {\(- .5\), 0, 1}, {\(-1.5\), \(-1\), .75}, {\(-1.5\), \(-2\), 0}, { .5, \(-2\), \(-1\)}}, {{2, 1, .75}, {2, 2, 0}, {0, 2, \(-1\)}, {0, 1, 1}, {1, 0, \(-1\)}, {2, \(-1\), \(- .75\)}, {2, \(-2\), 0}, {0, \(-2\), 1}, {0, \(-1\), \(-1\)}, {1, 0, 1}, {2, 1, .75}}, {{2.5, 0, \(-1\)}, {1.5, 1, \(- .75\)}, {1.5, 2, 0}, {3.5, 2, 1}, {3.5, 1, \(-1\)}, {2.5, 0, 1}, {1.5, \(-1\), .75}, {1.5, \(-2\), 0}, {3.5, \(-2\), \(-1\)}, {3.5, \(-1\), 1}, {2.5, 0, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unlinks3 = {{{0, \ 0, \ 0}, \ {1, \ 1, \ 0}, \ {0, \ 2, \ 0}, \ {\(-1\), \ 1, \ 0}, {0, \ 0, \ 0}}, \[IndentingNewLine]\ {{0, \ 1, \ 1}, \ {1, \ 0, \ 1}, \ {2, \ 1, \ 1}, \ {1, \ 2, \ 1}, {0, 1, \ 1}}, \[IndentingNewLine]\ {{1/2, \ 1/2, \ 1/2}, \ {3/2, \ 3/2, \ 1/2}, \[IndentingNewLine]\ {\ 1/2, \ 5/2, \ 1/2}, \ {\(-1\)/2, \ 3/2, \ 1/2}, {1/2, \ 1/2, \ 1/2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unlinks3a = \ {{{0, \ 2, \ 0}, {\(-1\), \ 1, \ 0}, \ {0, \ 0, \ 0}, \ {1, \ 1, \ 0}, {0, \ 2, \ 0}}, \[IndentingNewLine]{{1, \ 2, \ 1}, \ {0, \ 1, \ 1}, \ {1, \ 0, \ 1}, \ {2, \ 1, \ 1}, {1, \ 2, \ 1}}, \[IndentingNewLine]\ {{5/2, \ 0, \ 1/2}, \ {7/2, \ 1, \ 1/2}, \ {5/2, \ 2, \ 1/2}, {3/2, \ 1, \ 1/2}, {5/2, \ 0, \ 1/2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(unlinks3apart = \ {{{0, \ 2, \ 0}, {\(-1\), \ 1, \ 0}, \ {0, \ 0, \ 0}, \ {1, \ 1, \ 0}, {0, \ 2, \ 0}}, \[IndentingNewLine]{{3, \ 2, \ 1}, \ {2, \ 1, \ 1}, \ {3, \ 0, \ 1}, \ {4, \ 1, \ 1}, {3, \ 2, \ 1}}, \[IndentingNewLine]\ {{5/2, \ 2, \ 1/2}, \ {7/2, \ 3, \ 1/2}, \ {5/2, \ 4, \ 1/2}, {3/2, \ 3, \ 1/2}, {5/2, \ 2, \ 1/2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(hopf = {{{0, \ 0, \ 0}, \ {1, \ 1, \ 1}, \ {0, \ 2, \ 2}, \ {\(-1\), \ 1, \ 1}, {0, \ 0, \ 0}}, \ {{2, \ 1, \ 1}, \ {1, \ 2, \ 0}, {0, \ 1, \ 1}, {1, 0, \ 2}, {2, 1, 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(hopflh = {{{0, \ 0, 2}, \ {1, \ 1, \ 1}, \ {0, \ 2, \ 0}, \ {\(-1\), \ 1, \ 1}, {0, \ 0, 2}}, \[IndentingNewLine]\ {{2, \ 1, \ 1}, \ {1, \ 2, \ 2}, {0, \ 1, \ 1}, \ {1, 0, 0}, {2, \ 1, \ 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(lnk623 = {{{0, 1, 0}, {1, 0, 0}, {0, \(-1\), 0}, {\(-1\), 0, 0}, {0, 1, 0}}, \[IndentingNewLine]{{\(-1.4\), 0, 0}, {\(- .9\), .5, 1}, {\(- .3\), 0, \(-1\)}, {0, \(- .5\), 1}, { .3, 0, 1}, { .9, .5, \(-1\)}, {1.4, 0, 0}, { .9, \(- .5\), 1}, { .3, 0, \(-1\)}, {0, .5, 0}, {\(- .3\), 0, 1}, {\(- .9\), \(- .5\), \(-1\)}, {\(-1.4\), 0, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(borrom = {{{2, 0, 0}, {0, \(-3\), 0}, {\(-2\), 0, 0}, {0, 3, 0}, {2, 0, 0}}, {{\(-3\), 0, 0}, {0, 0, 1}, {3, 0, 0}, {0, 0, \(-1\)}, {\(-3\), 0, 0}}, {{0, 0, \(-3\)}, {1, 1, 0}, {0, 0, 3}, {\(-1\), \(-1\), 0}, {0, 0, \(-3\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(borrom3a = {{{1, 0, 5}, {6.25, 5, 0}, {1.25, 10, 5}, {\(-3.75\), 5, 0}, {1, 0, 5}}, {{\(-1.25\), 5, 5}, {3.75, 0, 0}, {8.75, 5, 5}, {3.75, 10, 0}, {\(-1.25\), 5, 5}}, {{2, 1, 2}, {7, 6, 1}, {2, 11, 2}, {\(-2\), 6, 3}, {2, 1, 2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(lnk633 = {{{0, 1, \(-1\)}, { .3, 1.5, 1}, {0, 2, 1}, {\(- .87\), 1.72, 1}, {\(-1.72\), .87, 1}, {\(-2\), 0, 1}, {\(-1.72\), \(- .87\), 1}, {\(-1.1\), \(- .9\), 0}, {\(- .86\), \(- .43\), \(-1\)}, {\(- .87\), .43, \(-1\)}, \ {0, 1, \(-1\)}}, {{0, 1, 1}, {\(- .3\), 1.5, 0}, {0, 2, \(-1\)}, { .87, 1.72, \(-1\)}, {1.72, .87, \(-1\)}, {2, 0, \(-1\)}, {1.72, \(- .87\), \(-1\)}, {1.1, \(- .9\), 0}, { .87, \(- .43\), 1}, { .87, .43, 1}, {0, 1, 1}}, \[IndentingNewLine]{{1.72, \(- .87\), 1}, {1.5, \(- .3\), 0}, { .87, \(- .43\), \(-1\)}, {0, \(- .87\), 0}, {\(- .87\), \(- .43\), 1}, {\(-1.5\), \(- .3\), 0}, {\(-1.72\), \(- .87\), \(-1\)}, {\(-1\), \(-1.6\), .5}, \ {0, \(-1.85\), 1}, {1, \(-1.6\), 1}, {1.72, \(- .87\), 1}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(whitehead = {{{0, 0, 1}, {1, 1, \(-1\)}, {2, 0, 0}, {1, \(-1\), 1}, {0, 0, \(-1\)}, {\(-1\), 1, 1}, {\(-2\), 0, 0}, {\(-1\), \(-1\), \(-1\)}, {0, 0, 1}}, {{\(-1\), 1, 0}, {\(-1\), \(-1\), 0}, {1, \(-1\), 0}, {1, 1, 0}, {\(-1\), 1, 0}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(whitehead2 = {{{3/2, 0, 7/4}, {2, 2, 3/2}, {2, 4, 1}, {5/4, 6, 1}, {\(-1\), 6, 1}, {\(-2\), 3, 1/2}, {\(-1\), 0, 1/4}, {0, 0, 0}, {1/4, 1/2, 1}, {0, 1, 2}, {\(-1\), 3, 3/2}, {0, 5, 1}, {1, 4, 1}, {1, 2, 1/2}, {0, 1, 0}, {\(-1\)/4, 1/2, 1}, {0, 0, 2}, {3/2, 0, 7/4}}, \[IndentingNewLine]{{3, 2, 2}, {3, 4, 0}, {0, 4, 0}, {0, 2, 2}, {3, 2, 2}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(lnk631 = {{{0, 1, \(-1\)}, { .3, 1.5, 0}, {0, 2, 1}, {\(- .87\), 1.72, .5}, {\(-1.72\), .87, 0}, {\(-2\), 0, \(- .5\)}, {\(-1.72\), \(- .87\), \(-1\)}, {\(-1.1\), \(- .9\ \), 0}, {\(- .86\), \(- .43\), 1}, {\(- .87\), .43, 0}, {0, 1, \(-1\)}}, {{0, 1, 1}, {\(- .3\), 1.5, 0}, {0, 2, \(-1\)}, { .87, 1.72, \(- .5\)}, {1.72, .87, 0}, {2, 0, .5}, {1.72, \(- .87\), 1}, {1.1, \(- .9\), 0}, { .87, \(- .43\), \(-1\)}, { .87, .43, 0}, {0, 1, 1}}, \[IndentingNewLine]{{1.72, \(- .87\), \(-1\)}, {1.5, \(- \ .3\), 0}, { .87, \(- .43\), 1}, {0, \(- .87\), 0}, {\(- .87\), \(- .43\), \(-1\)}, {\(-1.5\), \(- .3\), 0}, {\(-1.72\), \(- .87\), 1}, {\(-1\), \(-1.6\), .5}, {0, \(-2\), 0}, {1, \(-1.6\), \(- .5\)}, {1.72, \(- .87\), \(-1\)}}};\)\)], \ "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(\(penta = {{{0, \ 0, \ 0}, {8, \ 4, \(-h\)}, {8, \ 12, \ h}, \ {4, \ 16, \(-h\)}, \ {2, \ 17, \ h}, \ {\(-2\), \ 17, \(-h\)}, \ {\(-4\), \ 16, \ h}, \ {\(-8\), \ 12, \(-h\)}, \ {\(-8\), \ 4, \ h}, {0, \ 0, \ 0}}, {{\(-14\), \ 10, \ 0}, \ {\(-8\), \ 4, \(-h\)}, \ {0, \ 6, \ h}, \ {3, \ 11, \(-h\)}, \ {3, \ 14, \ h}, \ {2, \ 17, \(-h\)}, \ {0, \ 19, \ h}, \ {\(-5\), \ 22, \(-h\)}, \ {\(-12\), \ 19, \ h}, {\(-14\), \ 10, \ 0}}, \[IndentingNewLine]{{\(-9\), \ 27, \ 0}, \ {\(-12\), \ 19, \(-h\)}, \ {\(-8\), \ 12, \ h}, \ {\(-3\), \ 11, \(-h\)}, \ {0, \ 12, \ h}, \ {3, \ 14, \(-h\)}, \ {4, \ 16, \ h}, \ {\ 5, \ 22, \(-h\)}, \ {0, \ 28, \ h}, {\(-9\), \ 27, \ 0}}, \[IndentingNewLine]{{9, \ 27, \ 0}, \ {0, \ 28, \(-h\)}, \ {\(-5\), \ 22, \ h}, \ {\(-5\), \ 16, \(-h\)}, \ {\(-3\), \ 14, \ h}, \ {0, \ 12, \(-h\)}, \ {3, \ 11, \ h}, \ {8, \ 12, \(-h\)}, \ {12, \ 19, \ h}, {9, \ 27, \ 0}}, \[IndentingNewLine]{{14, \ 10, \ 0}, \ {12, \ 19, \(-h\)}, \ {5, \ 22, \ h}, \ {0, \ 19, \(-h\)}, \ {\(-2\), \ 17, \ h}, \ {\(-3\), \ 14, \(-h\)}, \ {\(-3\), \ 11, \ h}, \ {0, \ 6, \(-h\)}, \ {8, \ 4, \ h}, {14, \ 10, \ 0}}}/3\ /. \ h\ -> \ \(-1\);\)\(\ \)\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9], Cell[BoxData[ \(\(dowtest = {{{1, \(-2\), 1}, {\(-1\), \(-1\), \(-1\)}, {2, 1, 1}, {2, \(-1\), \(-1\)}, {\(-1\), 1, 1}, {1, 2, \(-1\)}, {1, \(-2\), 1}}, {{3, 1, \(-1\)}, {4, 0, 0}, {3, \(-1\), 1}, {2, 0, 0}, {3, 1, \(-1\)}}, {{9/2, 1, 1}, {11/2, 0, 0}, {9/2, \(-1\), \(-1\)}, {7/2, 0, 0}, {9/2, 1, 1}}, {{6, 1, \(-1\)}, {7, 0, 0}, {6, \(-1\), 1}, {5, 0, 0}, {6, 1, \(-1\)}}};\)\)], "Input", PageWidth->PaperWidth, InitializationCell->True, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell["8. Usage & Global variables in alphabetic order.", "Section", PageWidth->PaperWidth, InitializationCell->True], Cell[CellGroupData[{ Cell["8.1 Usage.", "Subsection"], Cell[BoxData[ RowBox[{ RowBox[{\(blist::"\"\), "=", "\"\\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"from\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"genknot\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crossings\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"index\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"or\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"K2K\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"files\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"\\\"\",\nFontSlant->\"Plain\"]\)"}], StyleBox[";", FontSlant->"Plain"]}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{\(blistDrawKnot::"\"\), "=", "\"\\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"bdata\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"output\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"blist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"so\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"that\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"it\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"can\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"be\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"handled\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"as\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"braid\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{\(blistTobword::"\"\), "=", "\"\\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"corresponding\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"bword\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"use\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"with\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\(\* StyleBox[\"K\",\nFontSlant->\"Plain\"]2K\)]\) routines\>\""}], ";"}]], "Input",\ PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(braid::"\"\), "=", "\"\<\!\(\* StyleBox[\"braid\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"braidlist_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) converts an \!\(\* StyleBox[\"braidlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"vertical\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"indices\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"up\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crossings\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"in\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"horizontal\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"braid\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"negated\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"it\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"an\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"underpass\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"braid\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\) If the index is negated, the lower \ braid passes under the upper braid.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(bridgeCount::"\"\), "=", "\"\<\!\(\* StyleBox[\"bridgeCount\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) gives the count of the arcs with \ one or more overcrossings between undercrossings. The \!\(\* StyleBox[\"bridgenumber\",\nFontSlant->\"Italic\"]\) is the least bridgecount \ for any projection of the knot; it often involves a non-minimal-crossing \ diagram such as \!\(\* StyleBox[\"simple2\",\nFontSlant->\"Italic\"]\) & \!\(\* StyleBox[\"fig8a\",\nFontSlant->\"Italic\"]\).\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(bwordToblist::"\"\), "=", "\"\\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)(\!\(\* StyleBox[\"used\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"in\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\(\* StyleBox[\"K\",\nFontSlant->\"Plain\"]2K\)]\) routines)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"corresponding\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"braidlist\",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{\(ConwayUnpack::\ "\"\), "=", "\"\<\!\(\* StyleBox[\"ConwayUnpack\",\nFontColor->RGBColor[0, 1, \ 0]]\)[c_String,f_:False] returns the string c unpacked as a list of integers \ for use by \!\(\* StyleBox[\"kConway\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\) Currently it can only handle 1* \ knots & links, rejecting entries such as '.2.2', '8*', '2:2:2'. If f=\!\(\* StyleBox[\"True\",\nFontSlant->\"Italic\"]\) the result and the continued \ fraction are printed.\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(crossings::"\"\), "=", "\"\<\!\(\* StyleBox[\"crossings\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"xyz_:\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"xyz\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) finds and labels the crossings in \ the diagram represented by \!\(\* StyleBox[\"xyz\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"This\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"created\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"by\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Each\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chord\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"compared\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"with\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"all\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"later\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chords\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"skipping\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"at\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"link\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"boundaries\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"If\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"diagonal\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"rectangles\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"overlap\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crossing\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"point\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"two\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"extended\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chords\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"found\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"If\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"it\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"true\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crossing\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"it\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"numbered\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"analysed\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"overpass\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"orientation\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"The\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"diagram\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"output\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"as\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Graphics\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"object\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"with\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"overpass\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"above\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"underpass\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"which\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"negated\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"orientation\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"negative\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"The\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chord\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"thickness\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"proportional\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"z\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Also\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"see\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"shortcut\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crosscurv\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"which\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"calls\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"&\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"crossings\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"with\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"optimized\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"options\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"shows\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"result\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(crosscurv::"\"\), "=", "\"\<\!\(\* StyleBox[\"crosscurv\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"List_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"opts__\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) calls \!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"list\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"rad\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"0\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"chordno\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"2\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"opts\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crossings\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)]\)\!\(\* StyleBox[\"If\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"list\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"single\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"line\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"writhe\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"dowth\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"are\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"output\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"pr\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"=\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"1\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"w\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"2\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"both\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"or\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"3\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"d\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"The\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"annotated\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"knot\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"diagram\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"shown\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"with\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chord\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"thickness\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"proportional\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"z\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Italic\"]\)suppressed if pr<0\!\(\* StyleBox[\")\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(curvs::"\"\), "=", "\"\<\!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"{\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"linelists\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"opts___Rule\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) interpolates and creates the \ space-curves ('links' or 'loops' if closed) defined in {\!\(\* StyleBox[\"linelists\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\) as\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)lines or (if 3D & \!\(\* StyleBox[\"rad\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\">\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"0\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)as tubes. Diagnostic output is given \ by setting various statements \!\(\* StyleBox[\"If\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"[\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"pr\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, \ 0]]\)\!\(\* StyleBox[\">\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"8.\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, \ 0]]\)\!\(\* StyleBox[\"..\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, \ 0]]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\(\* StyleBox[\"I\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, 0]]\* StyleBox[\"f\",\nFontColor->RGBColor[1, 0, 0]]\)]\)\!\(\* StyleBox[\"[\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"pr\",\nFontSlant->\"Italic\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\ \* StyleBox[\">\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"1.\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, \ 0]]\)\!\(\* StyleBox[\"..\",\nFontSlant->\"Plain\",\nFontColor->RGBColor[1, 0, \ 0]]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"recompiling\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)Plotting dimensions are selected \ from the lists in \!\(\* StyleBox[\"pointlist\",\nFontSlant->\"Italic\"]\) accordimg to \!\(\* StyleBox[\"showlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"{\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"1\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"2\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"3\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"etc\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\) The line will be closed if the \ first and last points coincide. Piecewise cubic interpolation gives the curve \ (or tube centreline) as \!\(\* StyleBox[\"chords\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"joining\",\nFontSlant->\"Plain\"]\) the points, with the slopes at \ each point beng that between neighbouring points. The interpolation applies a \ \!\(\* StyleBox[\"tension\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)(\!\(\* StyleBox[\"default\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"value\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)1\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"draws\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"near\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"circle\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"through\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"corners\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"square\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\) \!\(\* StyleBox[\"spacecurve\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"called\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"create\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"g\",\nFontSlant->\"Plain\"]\)lobal lists \!\(\* StyleBox[\"xy\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"...\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)& \!\(\* StyleBox[\"gcurv\",\nFontSlant->\"Italic\"]\) of the coordinates (for any \ number of dimensions)\!\(\* StyleBox[\";\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"they\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"are\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"output\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"but\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"not\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"shown\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"as\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"2\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"D\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"or\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"3\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"D\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"graphic\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"objects\",\nFontSlant->\"Plain\"]\). Options are: \!\(\* StyleBox[\"rad\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"defines\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"tube\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"radius\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"positive\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\";\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"creates\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"shadow\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"plot\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"zero\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\); \!\(\* StyleBox[\"showlist\",\nFontSlant->\"Italic\"]\) (selects the plotting \ coordinates, 3rd is under/over in 2D plots); \!\(\* StyleBox[\"chordno\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)(if real it is \!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)number of chords per unit \ length\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"curve\",\nFontSlant->\"Plain\"]\) adjusted to give an integral \ number of chords of similar lengths, if\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"integer\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"it\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chords\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"between\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"points\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\";\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"perimno\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)(\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chords\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"in\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"tube\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"perimeter\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\) \!\(\* StyleBox[\"fixing\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"quadrilateral\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"sizes\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"tube\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"surface\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\);\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"tension\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\";\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"twist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)(\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"offsets\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"adjacent\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"tube\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"surface\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"quadrilaterals\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Rational\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"values\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"are\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"twist\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"overall\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"others\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"are\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"twist\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"per\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"unit\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"length\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Other\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"options\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"are\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"passed\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"through\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Graphics3D\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)The display function is turned off \ whilst the picture is being built up, so that no plots appear; the complete \ picture can\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"be\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"plotted\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"by\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Show\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"or\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"included\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"in\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Show\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"GraphicsArray\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ RowBox[{ RowBox[{\(curvshow::"\"\), "=", "\"\<\!\(\* StyleBox[\"curvshow\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"h_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"cof_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"ls_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"sh\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"uo_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"u_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) is called by spacecurve. It appends \ 1D listplots, 2D plots, or 3D plots of each line to \!\(\* StyleBox[\"gcurv\",\nFontSlant->\"Italic\"]\).\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ RowBox[{ RowBox[{\(depthshow::"\"\), "=", "\"\\"Italic\"]\)s to create the knot diagram \ for decoration with \!\(\* StyleBox[\"nodpos\",\nFontSlant->\"Italic\"]\).\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(dowth::"\"\), "=", "\"\<\!\(\* StyleBox[\"dowth\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) finds the 'largest' set of even \ nodes that match the odd nodes (negated if it is the pass. This gives the \ Dowker or Dowker-Thisthlethwaite Name. The result is a list of lists so that \ links can be named.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(genKnot::"\"\), "=", "\"\\"Italic\"]\) where known.\n6. A \ \!\(\* StyleBox[\"lineList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"knot\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\) where known\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"\\\\n\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"7.\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)A \!\(\* StyleBox[\"kgraf\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"knot\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\) where known\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"\\\\n\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"8.\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"The\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"2\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"variable\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"HOMFLY\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"polynomial\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\) where known.\n9. The BLM/Ho \ Polynomial\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\) where known.\n10. The Kauffman \ Polynomial\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\) where known.\nThe braid number is \ omitted, as it is one more than the first \!\(\* StyleBox[\"reducedBraidList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(knotGraph::"\"\), "=", "\"\<\!\(\* StyleBox[\"knotGraph\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodes_:\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"par_:\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"1.2\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) creates a graph with a vertex in \ each black region of the knot shadow, with signed edges through each shared \ node. Isolated links are vertices without edges. The sign is the orientation \ of the node, shown as black for +ve, red for -ve. If the first test makes the \ outside black, change the sign of \!\(\* StyleBox[\"par\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\) The output is \!\(\* StyleBox[\"kgraf\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"can\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"be\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"shown\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"by\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"ShowGraph\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"kgraf\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Show\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"kgshow\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) superimposes the graph on the knot \ shadow, with edges distorted to pass through the vertices.\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"Abs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"par\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) is a scaling factor that can be \ used to improve the appearance of \!\(\* StyleBox[\"kgshow\",\nFontSlant->\"Italic\"]\). The vertices are rounded; \ enlarge the graph if this creates duplicates. Typical usage:-\n\ crosscurv[k08010];\!\(\* StyleBox[\"ShowGraph\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"knotGraph\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"1\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\";\",\nFontSlant->\"Italic\"]\)\n \!\(\* StyleBox[\"Fails\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"with\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\"Links\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\* StyleBox[\".\",\nFontColor->RGBColor[1, 0, 0]]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ \(InputForm\`\(K2KShow::"\" = "\";\)\)], "Input", PageWidth->PaperWidth, FormatType->StandardForm], Cell[BoxData[ RowBox[{ RowBox[{\(kConway::"\"\), "=", "\"\\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Conway\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Notation\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"string\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"c\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Currently\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"only\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"handles\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"strings\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"that\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"unpack\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"2\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"integers\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(kpretzel::"\"\), "=", "\"\\"Italic\"]\) for the pretzel knot with \ 3,4,5,6,7 or 8 tassels of |a[[i]]| crossings (left handed if a[[i]] \ negative). The final tassel may have an even number of crossings; otherwise \ there must be an odd number of odd tassels. Other combinations are excluded \ as they give links. 2-tassels are excluded as they are circular.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(lineEnds::"\"\), "=", "\"\<\!\(\* StyleBox[\"lineEnds\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"lin_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) creates a list, starting with zero, \ of the indices of the line ends in a flattened line or node list. It is used \ by \!\(\* StyleBox[\"crossings\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"linkMatrix\",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(linkMatrix::"\"\), "=", "\"\<\!\(\* StyleBox[\"linkMatrix\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"sno_:\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) creates a matrix of signed \ crossings. The diagonal is the \!\(\* StyleBox[\"writhe\",\nFontSlant->\"Italic\"]\) (sum of signed self \ crossings). Linking numbers are above the diagonal, crossing counts below it.\ \>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(loopBraid::"\"\), "=", "\"\<\!\(\* StyleBox[\"loopBraid\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"braidlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) creates a knot as a braid closed by \ loops.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(nodeListToPdata::"\"\), "=", "\"\\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"created\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"by\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crosscurv\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"plist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"for\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"use\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"by\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"K2K\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"procedures\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(pdataToNodeList::"\"\), "=", "\"\\"Italic\"]\) to a \!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(perturb::"\"\), "=", "\"\<\!\(\* StyleBox[\"perturb\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"l_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"fraction_:\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".001\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"seed_:\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"8\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) returns a perturbed curve by adding \ a random number (terminal elements excepted, to maintain loops), in the range \ \!\(\* StyleBox[\"fraction\",\nFontSlant->\"Italic\"]\) \!\(\* StyleBox[\"(\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"Max\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"l\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"-\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"Min\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"l\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Italic\"]\)Unless a seed is specified, the same \ random numbers will be used.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(pointer::"\"\), "=", "\"\<\!\(\* StyleBox[\"pointer\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) is called by curvshow to put disks \ and indices at the points in 2D plots of curvs.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ RowBox[{ RowBox[{\(rad::"\"\), "=", "\"\<\!\(\* StyleBox[\"r\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"=\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"rad\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"/.\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"{\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"localopts\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)default \!\(\* StyleBox[\"rad\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"1\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"/\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"4\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"option\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"defining\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"radius\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"tube\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"round\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"defined\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"coreline\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"rad\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"0\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"gives\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"line\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(reducedBraidList::"\"\), "=", "\"\<\!\(\* StyleBox[\"reducedBraidList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"braidlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) goes some way towards creating a \ normal form by R1 elimination, maximizing by swapping non-adjacent pairs, and \ rotating and changing the sign to make the first number +ve. Outputs the \ normal form and the braids forming each link (Still needs long R3 \ moves.)\>\""}], ";"}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{\(ringBraid::"\"\), "=", "\"\<\!\(\* StyleBox[\"ringBraid\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"braidlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) creates a knot or link as a ring \ braid on concentric circles, after applying \!\(\* StyleBox[\"reducedBraidList\",\nFontSlant->\"Italic\"]\), in \!\(\* StyleBox[\"linelist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"form\",\nFontSlant->\"Plain\"]\). \!\(\* StyleBox[\"loopBraid\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"preferable\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"crosscurv\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"to\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"be\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"used\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(R1::"\"\), "=", "\"\<\!\(\* StyleBox[\"R1\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"n\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) eliminates up \[Alpha] crossings, \ lines that simply cross themselves.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(Rtidy::"\"\), "=", "\"\<\!\(\* StyleBox[\"Rtidy\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"b\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) returns the renumbered nodes after \ some have been removed by R1, R2, or R3\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(R2::"\"\), "=", "\"\<\!\(\* StyleBox[\"R2\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"n\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) eliminates up to \!\(\* StyleBox[\"n\",\nFontSlant->\"Italic\"]\) \[NotSubset] crossings, where a \ line crosses another twice on the same side.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(R3::"\"\), "=", "\"\<\!\(\* StyleBox[\"R3\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"m\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"n\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) switches the \!\(\* StyleBox[\"m\",\nFontSlant->\"Italic\"]\)'th to the \!\(\* StyleBox[\"n\",\nFontSlant->\"Italic\"]\)'th |\!\(\* StyleBox[\"\[Times]\",\nFontSize->18]\) crossings to \!\(\* StyleBox[\"\[Times]\",\nFontSize->18]\)|\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(showlist::"\"\), "=", "\"\<\!\(\* StyleBox[\"sh\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"=\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"showlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"/.\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"{\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"localopts\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)default \!\(\* StyleBox[\"showlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\){1,2,3}) indicates which dimensions \ to plot. If it is {0}, each coordinate will be plotted as a coloured line \ against the plotting parameter. If it is {n}, the n'th coordinate will be \ plotted as a coloured line against the plotting parameter. Curves will be \ plotted as 2D 'shadows' if it is {m,n}, or {m,n,o} with rad\[RightArrow]0, or \ if the data is only 2D. 'o' indicates the dimension defining above/below in \ this shadow. If the data is greater than 2D,{m,n,o} or {m,n,o,p} it will plot \ 3D curves or tubes, with \!\(\* StyleBox[\"p\",\nFontSlant->\"Italic\"]\) providing a hidden \ dimension.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(spacecurve::"\"\), "=", "\"\<\!\(\* StyleBox[\"spacecurve\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"pointlist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"r\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"ch\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"pe\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"te\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"tw\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) is called by \!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\) for each spacecurve in turn. \ Smooth closure is obtained if the first and last points of pointlist are \ identical; otherwise dummy segments are added at each end so that the ends \ are smooth but not connected. Cubic interpolation is then set up, using the \ \!\(\* StyleBox[\"pointlist\",\nFontSlant->\"Italic\"]\) and the slopes between the \ neighbouring points. \!\(\* StyleBox[\"curvshow\",\nFontSlant->\"Italic\"]\) or (if \!\(\* StyleBox[\"rad\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\">\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"0\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Plain\"]\) \!\(\* StyleBox[\"tubeshow\",\nFontSlant->\"Italic\"]\) is then called to create \ global lists \!\(\* StyleBox[\"xyz\",\nFontSlant->\"Italic\"]\) & \!\(\* StyleBox[\"gcurv\",\nFontSlant->\"Italic\"]\) of the coordinates, at \ intervals of approximately uniform length (specified by \!\(\* StyleBox[\"chordno\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"decimal\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"number\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chords\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"per\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"unit\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"length\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\";\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"chordno\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"will\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"be\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"used\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"if\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"it\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"integral\",\nFontSlant->\"Plain\"]\)). The completed picture is \ returned to \!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"and\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"output\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"as\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"Graphics\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"object\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ RowBox[{ RowBox[{\(tubeshow::"\"\), "=", "\"\<\!\(\* StyleBox[\"tubeshow\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"points\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"slopes\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"dl\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"r\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"p1\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\",\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"a0\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) generates a tube about the 3D \ spacecurve defined by points and slopes. The default Options[curvs] gives \ rad->1/4, chordno->3. (the typical chords reciprocal length, which is \ automatically adjusted to ensure similar lengths) and perimno\[Rule]6 (the \ surface mesh on the tube in the meridian direction and the longitudinal \ direction). Adapted from a Mathematica2 demo notebook by P.Boyland and \ S.Dickson, and its reincarnation as TubePlot.nb\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ RowBox[{ RowBox[{\(tension::"\"\), "=", "\[IndentingNewLine]", "\"\<\!\(\* StyleBox[\"te\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"=\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"tension\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"/.\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"{\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"localopts\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\) is an option for \!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\) that controls the line shape. \ High values straighten it, sharpening the corners at the points; low values \ correspond to internal pressure, and cause it to have cusps or loops at mid \ points. te\[GreaterEqual]1/4 is enforced.\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(thirdAngle::"\"\), "=", "\"\<\!\(\* StyleBox[\"thirdAngle\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"k_\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) produces a 2\[Times]2 array of \ plots; the specified knot (with any options) is projected onto the x, y, & z \ planes in the Third Angle projection (i.e. the y & z images are as seen from \ the far side of the x plot), together with a the default view. The scales of \ the views may not match. \>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[{ RowBox[{ RowBox[{\(twist::"\"\), "=", "\"\<\!\(\* StyleBox[\"tw\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"=\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"twist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"/.\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"{\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"localopts\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"}\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"(\",\nFontSlant->\"Plain\"]\)default \!\(\* StyleBox[\"twist\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"->\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"0\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\")\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"is\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"a\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"curvs\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"option\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"defining\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"twist\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"of\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"the\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"tube\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\"surface\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\!\(\* StyleBox[\" \",\nFontSlant->\"Plain\"]\)Real values are radians per unit \ length,rational values are total twists over the whole line\!\(\* StyleBox[\".\",\nFontSlant->\"Plain\"]\)\>\""}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ StyleBox[ RowBox[{"V", StyleBox["XYZ", FontSlant->"Italic"]}]], "::", "\"\\""}], "=", "\"\\"Italic\"]\) gives the Graphics3D \ ViewPoint{x,y,z} for xyz=003, 009, 090, 900, & 291.\>\""}], ";"}]}], "Input", PageWidth->PaperWidth, InitializationCell->True], Cell[BoxData[ RowBox[{ RowBox[{\(writhe::"\"\), "=", "\"\<\!\(\* StyleBox[\"writhe\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"[\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"nodeList\",\nFontSlant->\"Italic\"]\)\!\(\* StyleBox[\"]\",\nFontSlant->\"Italic\"]\) gives half the sum of the signed \ crossings of an oriented diagram. It is given for each line as the diagonal \ elements of \!\(\* StyleBox[\"linkMatrix\",\nFontSlant->\"Italic\"]\)\>\""}], ";"}]], "Input", PageWidth->PaperWidth, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["8.2 Global variables.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["chxyz", FontSlant->"Italic"], ".\tThe coordinates of the chord ends in ", StyleBox["gcurv", FontSlant->"Italic"], ".\n", StyleBox["DI", FontSlant->"Italic"], StyleBox[". \tDisplayFunction\[Rule]Identity, used to suppress displays for \ arrays.\n", FontSlant->"Plain"], StyleBox["ea, eb, ec", FontSlant->"Italic"], " The ends of a tangle, created by ", StyleBox["kConway", FontSlant->"Italic"], " and used by ", StyleBox["ConAdd", FontSlant->"Italic"], ".\n", StyleBox["edgs", FontSlant->"Italic"], ".\tThe list of edges in a knot graph\n", StyleBox["ER", FontSlant->"Italic"], StyleBox[".\tEdgeColor->RGB[1,0,0], used in ", FontSlant->"Plain"], StyleBox["knotGraph", FontSlant->"Italic"], StyleBox[".", FontSlant->"Plain"], "\n", StyleBox["gcurv.", FontSlant->"Italic"], "\tThe 2.5D plot of a knot as pairs of chords between nodes, with thickness \ proportional to height.\n", StyleBox["genKnot[[c,n,i]]. ", FontSlant->"Italic"], "The databank based on Weissteins ", StyleBox["Knots.m; ", FontSlant->"Italic"], "under development.\n", StyleBox["kg0m[[n]]", FontSlant->"Italic"], StyleBox[". An array of knot graphs", FontSlant->"Plain"], "\n", StyleBox["kgraf.", FontSlant->"Italic"], "\tThe combinatorica knot graph, created by ", StyleBox["knotGraph", FontSlant->"Italic"], ".\n", StyleBox["kgshow.", FontSlant->"Italic"], " The knot graph that superimposes ", StyleBox["edgs", FontSlant->"Italic"], " and ", StyleBox["vrtx", FontSlant->"Italic"], " on ", StyleBox["gcurv", FontSlant->"Italic"], "\n", StyleBox["nodeList.", FontSlant->"Italic"], " A list of link lists, each being a list of link sequential node pairs, \ with {{}} being an isolated loop. The first of the pair is negated if it is \ on the underpass; the second is negated if the vertex orientation is \ negative. Each link list is cyclic.\n", StyleBox["nodpos", FontSlant->"Italic"], StyleBox[". Labelling information for nodes in knot diagrams.\n", FontSlant->"Plain"], StyleBox["pr", FontSlant->"Italic"], ". A print-out parameter. ", StyleBox["crosscurv", FontSlant->"Italic"], " prints the link matrix if ", StyleBox["pr", FontSlant->"Italic"], " =1 or 2, and the Dowker notation for knots if ", StyleBox["pr", FontSlant->"Italic"], " =2 or 3. Many diagnostic messages are suppressed by ", StyleBox["If[pr>8...]", FontColor->RGBColor[1, 0, 0]], " and can be selectively activated by changing this to ", StyleBox["If[pr>-8...]", FontColor->RGBColor[1, 0, 0]], ".\n", StyleBox["pts", FontSlant->"Italic"], ". The point information for ", StyleBox["gcurv.", FontSlant->"Italic"], "\n", StyleBox["siz", FontSlant->"Italic"], StyleBox[". The difference between maximum and minimum coordinates, used to \ scale the indices on a plot. ", FontSlant->"Plain"], "\n", StyleBox["V003, V009, V090, V900", FontSlant->"Italic"], " ", StyleBox["Viewpoints.\n", FontSlant->"Plain"], StyleBox["V1 - V9", FontSlant->"Italic"], StyleBox[" vertex index instructions.", FontSlant->"Plain"], "\n", StyleBox["vrtx", FontSlant->"Italic"], ". The list of vertices in a knot graph.\n", StyleBox["xyz", FontSlant->"Italic"], ".", StyleBox[" The sequential set of coordinates of a line list, in any number \ (>1) of dimensions.\n\nThere may be some other variables that I forgot to \ make local!", FontSlant->"Plain"] }], "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["9. Appendix A. Piece-wise Cubic interpolation.", "Section", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["9.1. Fast Cubic Interpolation.", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "\tFitting a piecewise parametric cubic with the parameter t={0,1} between \ successive points, with the slope at each node being that between the \ neighbour points, gives a smooth interpolation in most cases. (A more general \ version specifies the slopes at each point, rather than calculating it from \ the neighbours. I originally developed this for rapid pressure-dependent \ two-component vapour-liquid equilibrium calculations.) The function \ a1+t*(a2+t*(a3+t*a4)) has values {a1, a2+a3+a4} and slopes {a2, a2+2*a3+3*a4} \ at t={0,1}. This gives an easy calculation for {a3, a4}. The parametric plot \ \"circles the square\" (see the next section) if the slope coefficients are \ multiplied by 1.6 - this does not alter the slope but alters the intermediate \ values; this factor is built into the routines. A curve is defined by \ n-dimensional points ", StyleBox["f0,", FontSlant->"Italic"], " with \"segments\" joining these points. The values of a, b, uo, s, and \ s2 are calculated as lists, corresponding to each segment, so intermediate \ points are given by \ f0\[LeftDoubleBracket]i\[RightDoubleBracket]+t(s[[i]]+t(a[[i]]+t*b[[i]]))) \ for 0\[LessEqual]t\[LessEqual]1. The length of each segment is calculated as \ ", StyleBox["seglen.", FontSlant->"Italic"], " The ", StyleBox["chordno", FontSlant->"Italic"], " parameter is used to divide segments into ", StyleBox["dt", FontSlant->"Italic"], " equal length chords, with a minimum of 2. If tubes are to be drawn, the \ slopes are interpolated by (s[[i]]+t(2a[[i]]+3t*b[[i]]))c; " }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{" ", RowBox[{\(fl = RotateLeft[f0]; s = .8 \((fl - RotateRight[f0])\)/te;\), "\n", \(uo = fl - f0; s2 = RotateLeft[s]; a = 3\ uo - 2 s - s2; b = \(-2\) uo + s + s2;\), "\n", StyleBox[\( (*Find\ segment\ lengths\ and\ subdivisions\ *) \), FontColor->RGBColor[0, 0, 1]], StyleBox["\[IndentingNewLine]", FontColor->RGBColor[0, 0, 1]], \(seglen = Simplify[ Sqrt[Plus @@ Transpose\ [ 4\ a\^2/3 + 3\ a\ b + 9\ b\^2/5 + 2\ \((a + b)\)\ s + s\^2]]]; dt = IntegerPart[seglen\ chordno + 1];\), StyleBox["\[IndentingNewLine]", FontColor->RGBColor[1, 0, 0]], RowBox[{ RowBox[{"Do", "[", RowBox[{ RowBox[{\(d = dt[\([i]\)]\), ";", \(ds = seglen[\([i]\)]/dt[\([i]\)]\), ";", RowBox[{"If", "[", RowBox[{\(d \[NotEqual] 0\), ",", StyleBox[\( (*ignore\ lengths\ of\ zero*) \), FontColor->RGBColor[0, 0, 1]], "\n", " ", \(Do[ AppendTo[ cof, \((f0\[LeftDoubleBracket] i\[RightDoubleBracket] + t \((s[\([i]\)] + t \((a[\([i]\)] + t*b[\([i]\)])\))\))\)]; \ \[IndentingNewLine]If[r > 0, (*tube*) \ AppendTo[ slopes, \((s[\([i]\)] + t \((2 a[\([i]\)] + 3 t*b[\([i]\)])\))\) ds]]; \[IndentingNewLine]{t, 0, 1, 1/d}]\)}], "]"}]}], ",", "\n", " ", \({i, dl, dr}\)}], "]"}], ";"}]}]}]], "Input", PageWidth->PaperWidth], Cell["\<\ The cubic equation parameters {a1, a2, a3, a4} can be expressed directly in \ terms of the arrays of the coordinates \"f\" and the required slopes \"s\" as\ \ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \({f\[LeftDoubleBracket]i\[RightDoubleBracket], s\[LeftDoubleBracket]i\[RightDoubleBracket], 3 \((\ f\[LeftDoubleBracket]1 + i\[RightDoubleBracket] - \ f\[LeftDoubleBracket]i\[RightDoubleBracket])\) - 2\ s\[LeftDoubleBracket]i\[RightDoubleBracket] - s\[LeftDoubleBracket]1 + i\[RightDoubleBracket], 2\ \((f\[LeftDoubleBracket]i\[RightDoubleBracket] - \ f\[LeftDoubleBracket]1 + i\[RightDoubleBracket])\) + s\[LeftDoubleBracket]i\[RightDoubleBracket] + s\[LeftDoubleBracket]1 + i\[RightDoubleBracket]}\)], "Input", PageWidth->PaperWidth], Cell["\<\ The Horner form of the function (which needs a list with one prepended and \ two appended values to provide f\[LeftDoubleBracket]-1+i\[RightDoubleBracket] \ and f\[LeftDoubleBracket]2+i\[RightDoubleBracket] ) is then\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(H[f_, i_, t_] := f\[LeftDoubleBracket]i\[RightDoubleBracket] + t \((4 \((\(-f\[LeftDoubleBracket]\(-1\) + i\[RightDoubleBracket]\) + f\[LeftDoubleBracket]1 + i\[RightDoubleBracket])\)/5 + t \((\((8\ f\[LeftDoubleBracket]\(-1\) + i\[RightDoubleBracket] - 11\ f\[LeftDoubleBracket]i\[RightDoubleBracket] + 7\ f\[LeftDoubleBracket]1 + i\[RightDoubleBracket] - 4\ f\[LeftDoubleBracket]2 + i\[RightDoubleBracket])\)/5 + 2 t \((\(-2\)\ f\[LeftDoubleBracket]\(-1\) + i\[RightDoubleBracket] + 3\ f\[LeftDoubleBracket]i\[RightDoubleBracket] - 3\ f\[LeftDoubleBracket]1 + i\[RightDoubleBracket] + 2\ f\[LeftDoubleBracket]2 + i\[RightDoubleBracket])\)/ 5)\))\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Any number of dimensions can be processed because arrays of data lists are \ handled by ", StyleBox["Mathematica", FontSlant->"Italic"], " just as easily as single lists - though only 2 or 3 dimensional curves \ can be plotted. " }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "9.2. Varying ", StyleBox["tension", FontSlant->"Italic"], "." }], "Subsection", PageWidth->PaperWidth], Cell["\<\ Example A1 draws a curve through the corners of a square, showing tension \ decreasing from 20 (drawing the innermost near-square line) down to .25 \ (drawing the outermost line with cusps). As values <.25 may create \ unintentional cusps or crossings and values >20 approximate to linear \ interpolation, values outside this range are replaced by linear \ interpolation.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", \(Example\ A1 . Varying\ \(\(tension\)\(.\)\)\), StyleBox["*)", FontSlant->"Plain"]}], StyleBox["\[IndentingNewLine]", FontSlant-> "Plain"], \(sq = {{{0, 1}, {1, 0}, {0, \(-1\)}, {\(-1\), 0}, {0, 1}}}; \ figs = {{}, {}, {}, {}, {}}; figs[\([1]\)] = curvs[sq, tension \[Rule] .25]; figs[\([2]\)] = curvs[sq, tension \[Rule] .5]; figs[\([3]\)] = curvs[sq, tension \[Rule] .8]; figs[\([4]\)] = curvs[sq, tension \[Rule] 2]; figs[\([5]\)] = curvs[sq, tension \[Rule] 20]; Show[figs]; Clear[figs];\)}]], "Input", PageWidth->PaperWidth], Cell[TextData[{ "The slope at each point is that of the chord joining the neighbours of the \ point. Squares give pseudo-circles when ", StyleBox["tension", FontSlant->"Italic"], "=1; other regular polygons need other values. This is demonstrated for an \ equilateral triangle and a pentagon; the circumcircle is also plotted. ", StyleBox["tension", FontSlant->"Italic"], "\[Rule].6 and 1.2 give a close match. (These ", StyleBox["tension ", FontSlant->"Italic"], "parameters could be optimized to improve the fit between the chord ends \ and the true circles.)" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{\( (*Example\ A2 . \ Equilateral\ triangle\ pseudo\ circle\ with\ tension \[Rule] \ .6; \ fewer\ chords\ are\ used\ for\ clarity*) \), RowBox[{ RowBox[{"Show", "[", RowBox[{ StyleBox[\(curvs[{{{\(-\@3\)/2, \(-1\)/2, 0}, {0, 1, 0}, {\@3/2, \(-1\)/2, 0}, {\(-\@3\)/2, \(-1\)/2, 0}}}, showlist \[Rule] {1, 2}, tension \[Rule] .6, chordno -> 3]\), FontSlant->"Plain"], StyleBox[",", FontSlant->"Plain"], \(Graphics[Circle[{0, 0}, 1], AspectRatio -> Automatic]\)}], "]"}], ";"}]}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ "(*", \(Example\ A3 . \ Pentagonal\ points\ give\ a\ pseudo - circle\ with\ tension = 1.2\), " ", StyleBox["*)", FontSlant->"Plain"]}], StyleBox["\[IndentingNewLine]", FontSlant->"Plain"], RowBox[{ RowBox[{ StyleBox["p5", FontSlant->"Plain"], StyleBox["=", FontSlant->"Plain"], RowBox[{ StyleBox["2", FontSlant->"Plain"], \(\[Pi]/5\)}]}], ";", RowBox[{ StyleBox["Show", FontSlant->"Plain"], StyleBox["[", FontSlant->"Plain"], RowBox[{\(curvs[{{{Cos[p5], Sin[p5]}, {Cos[2 p5], Sin[2 p5]}, {Cos[3 p5], Sin[3 p5]}, {Cos[4 p5], Sin[4 p5]}, {Cos[5 p5], Sin[5 p5]}, {Cos[p5], Sin[p5]}}}, tension \[Rule] 1.2, chordno \[Rule] 2]\), StyleBox[",", FontSlant->"Plain"], \(Graphics[Circle[{0, 0}, 1], AspectRatio -> Automatic]\)}], "]"}], ";"}]}]], "Input", PageWidth->PaperWidth], Cell["\<\ Adding Axes->True in Example 4 shows that a right-angle triangle \ {0,1},{1,0},{-1,0}, with tension\[Rule].6, gives an approximate ellipse \ through the specified points.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ "(*", \(Example\ A4 . Rightangle\ Triangle\ gives\ a\ pseudo\ ellipse\ with\ tension \ \[Rule] .6\), StyleBox["*)", FontSlant->"Plain"]}], \(Show[ curvs[tri = {{{0, 1}, {1, 0}, {\(-1\), 0}, {0, 1}}}, tension \[Rule] .6], Axes \[Rule] True];\)}]], "Input", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["10. Appendix B. Using the Tuba package.", "Section", PageWidth->PaperWidth], Cell[TextData[{ "\t", StyleBox["This work was commenced before the ", FontSlant->"Plain"], "Tuba", StyleBox[" package [7] became available. If ", FontSlant->"Plain"], "Tuba.m", StyleBox[" is put into ", FontSlant->"Plain"], "Tuba", StyleBox[" in the Additional Packages directory it can be used with ", FontSlant->"Plain"], "curvs", StyleBox[" data; the outer parentheses (which allow multiple lines} have to \ be stripped off, e.g. by ", FontSlant->"Plain"], "simple[[1]]", StyleBox[" in place of ", FontSlant->"Plain"], "simple", StyleBox[". Only 3D data is acceptable. Cubic interpolation becomes \ overall, rather than piecewise.", FontSlant->"Plain"] }], "Text", PageWidth->PaperWidth, FontSlant->"Italic"], Cell[BoxData[ RowBox[{\(Off[First::"\", Syntax::"\"]\), ";", RowBox[{"<<", StyleBox["\"\\"", FontSlant->"Plain"]}]}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "The", " ", "simple", " ", "knot", " ", "plotted", " ", "by", " ", StyleBox["Tuba", FontSlant->"Italic"]}], StyleBox[" ", FontSlant->"Italic"], "*)"}], \(Show[tube[simple[\([1]\)], Red, .5], V009];\)}]], "Input", PageWidth->PaperWidth], Cell["\<\ Multiple lines can be plotted together, either individually or in a table:-\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "The", " ", \(Weaver'\), "s", " ", "knot", " ", "plotted", " ", "by", " ", StyleBox["Tuba", FontSlant->"Italic"], StyleBox[" ", FontSlant->"Italic"], "in", " ", "two", " ", "colours"}], "*)"}], \(Show[{tube[weavers[\([1]\)], Hue[ .7], \ .15]\ , tube[weavers[\([2]\)], \ Red, \ .15]}];\)}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{"Herringbone", " ", "Weave", " ", "plotted", " ", "by", " ", StyleBox["Tuba", FontSlant->"Italic"], StyleBox[" ", FontSlant->"Italic"], "in", " ", "three", " ", "colours"}], "*)"}], \(Show[ Table[tube[weave77a[\([i]\)], Hue[Mod[i, 3, 1]/3.5], .3], {i, 14}]];\)}]], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["11. References.", "Section", PageWidth->PaperWidth], Cell[TextData[{ "[1] ", Cell[BoxData[ FormBox[ UnderscriptBox[ StyleBox[\(\(\(http\)\(:\)\) // \(\(mathworld . wolfram . com/ images\)/knots\)/xx - yyy . gif\), FontSlant->"Italic"], "_"], TraditionalForm]], FontColor->RGBColor[0, 0, 1]], "shows the yyy'th knot with xx crossings. E.g. 08-003 gives the knot called \ k08003 in Section 6 and ", Cell[BoxData[ \(TraditionalForm\`8\_3\)]], "in [4]." }], "Text", PageWidth->PaperWidth], Cell["[2] The Ashleigh Book of Knots. Faber 1944.", "Text", PageWidth->PaperWidth], Cell[TextData[{ "[3] KnotPlot. ", Cell[BoxData[ FormBox[ StyleBox[\(\(\(\(\(\(www . cs . ubc . ca/nest\)/imager\)/\ contributions\)/ scharein\)/\(\(KnotPlot\)\(.\)\(html\)\(\ \)\)\)\+_\), FontColor->RGBColor[0, 0, 1]], TraditionalForm]], FontSlant->"Italic"] }], "Text", PageWidth->PaperWidth], Cell["\<\ [4] The Knot book. Colin C. Adams, W.H.Freeman, 1994. 514.224\ \>", "Text", PageWidth->PaperWidth], Cell["\<\ [5] An Introduction to knot theory, W.B. Raymond Lickorish, Springer 1997. \ 514.224\ \>", "Text", PageWidth->PaperWidth], Cell["\<\ [6] Knots and Physics, 1991. Louis H.Kauffman. World Scientific, 1991. \ 514.224\ \>", "Text", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["[7] ", FontSlant->"Plain"], StyleBox["http://library.wolfram.com/infocenter/MathSource/822/", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}] }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "[8] ", Cell[BoxData[ \(TraditionalForm\`\(\(\(http\)\(:\)\) // \(\(mathworld . wolfram . \ com/packages\)/Knots\)/Knots . m\)\+_\)], FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]] }], "Text"], Cell["\<\ [9] On enumeration of knots....., John Horton Conway, pp329-358, Comp. Probs. \ in Abstract Algebra, Proc. Conf. Oxford 1967, ed J. Leech, 1970. 512.02\ \>", "Text", PageWidth->PaperWidth], Cell[TextData[{ "[10] ", Cell[BoxData[ \(TraditionalForm\`\(\(\(http\)\(:\)\) // \(en . wikipedia . \ org/wiki\)/Knots\)\+_\)], FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]] }], "Text"], Cell[TextData[{ "[11] ", Cell[BoxData[ \(TraditionalForm\`\(\(\(http\)\(:\)\) // \(\(www . liv . ac . uk/\(\(~\ \)\(su14\)\)\)/programs\)/jones12 . p\)\+_\)], FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]] }], "Text"], Cell[TextData[{ "[12] ", Cell[BoxData[ \(TraditionalForm\`\(\(\(http\)\(:\)\) // \(\(burtleburtle . \ net/bob\)/knot\)/thesis . html\)\+_\)], FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]] }], "Text"], Cell[TextData[{ "[13] ", Cell[BoxData[ FormBox[ StyleBox[\(\(\(\(http\)\(:\)\) // \(\(\(\(library . wolfram . com/ infocenter\)/Articles\)/5285\)\(/\)\)\)\+_\), FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], TraditionalForm]]] }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["12. Glossary.", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Based on [2], [4], & [5]. Multi-loop and many-dimension space-curves are \ allowed.\n", StyleBox["Summary:-", FontWeight->"Bold"], "\nSets of d-dimensional ", StyleBox["points", FontSlant->"Italic"], " describe ", StyleBox["space-curves", FontSlant->"Italic"], " joined by ", StyleBox["sections", FontSlant->"Italic"], " subdivided by cubic interpolation into ", StyleBox["chords. ", FontSlant->"Italic"], "Their 2D projections are ", StyleBox["shadows", FontSlant->"Italic"], "; ", StyleBox["crossings", FontSlant->"Italic"], " are where curves cross in a shadow. ", StyleBox["Knot diagrams", FontSlant->"Italic"], " are 2.5D projections of one (", StyleBox["knots", FontSlant->"Italic"], ") or more (", StyleBox["links", FontSlant->"Italic"], ") closed curves, described by ", StyleBox["segments ", FontSlant->"Italic"], "between sequentially numbered ", StyleBox["nodes", FontSlant->"Italic"], ". Each crossings is converted to a node with two signed indices; if the \ first index is on the undercrossing it is negated. If the node has negative \ orientation the second index is negated. The list of signed nodes defines the \ diagram, providing data for knot analysis. ", StyleBox["knotGraph", FontSlant->"Italic"], " creates graphs with ", StyleBox["vertices", FontSlant->"Italic"], " in black regions, joined by signed ", StyleBox["edges", FontSlant->"Italic"], " through nodes. Various other terms are defined." }], "Text", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["Alternating", FontWeight->"Bold"], "\tA diagram which changes under\[ShortRightArrow]over or over\ \[ShortRightArrow]under at the end of each segment.\n", StyleBox["Arc", FontWeight->"Bold"], "\t\t1 or more Knot Diagram ", StyleBox["segments", FontSlant->"Italic"], ", from an undercrossing to the first overcrossing. L.H.Kauffman [6]. Adams \ [4] calls it a strand.\n", StyleBox["bword", FontWeight->"Bold"], "\tThe very compact braid descriptor in K2K [13], in which upper and lower \ case letters identify under and overcrossings of the braids.\n", StyleBox["Bend", FontWeight->"Bold"], "\t\t\"unites two ropes, or parts of the same rope, usually at the \ ends.\"[2]", StyleBox["\n", FontWeight->"Bold"], StyleBox["b0m00n", FontWeight->"Bold", FontSlant->"Italic"], "\tA ", StyleBox["braidList", FontSlant->"Italic"], " for the n'th simple knot with m crossings in the standard list. It may \ have more than ", StyleBox["m", FontSlant->"Italic"], " crossings.\n", StyleBox["Braid Index", FontWeight->"Bold"], "\tThe minimum number of braids required to describe a knot.\n", StyleBox["Braid ", FontWeight->"Bold"], "\t\tA set of 3D spacecurves moving across the page (down in [4] & [6]) \ with crossings between adjacent levels. Closed braids represent knots or \ links, with the convention that the ends loop back to the beginnings on the \ same level. Braids can be described as ", StyleBox["linelists", FontSlant->"Italic"], ", but ", StyleBox["braid[braidlist]", FontSlant->"Italic"], " uses the much more compact ", StyleBox["braidlist", FontSlant->"Italic"], " that encapsulates the ", StyleBox["braid word", FontSlant->"Italic"], " as a signed list of crossovers, e.g. {2,-3,-3,2}.\n", StyleBox["braidList\t", FontWeight->"Bold", FontSlant->"Italic"], "A signed list of strands that move up in a horizontal ", StyleBox["braid", FontSlant->"Italic"], ", negated if it is the underpass. ", StyleBox["reducedBraidList", FontSlant->"Italic"], " gives a simplified list, maximized by choice of starting point, and with \ a list of the braids that constitute each link. Called ", StyleBox["bnum", FontSlant->"Italic"], " in K2K.\n", StyleBox["Braid word", FontWeight->"Bold"], "\tA list e.g. ", Cell[BoxData[ \(TraditionalForm\`\(\[Sigma]\_2\) \(\[Sigma]\_3\%\(-2\)\) \ \[Sigma]\_1\)]], " describing a braid as a series of crossovers.\n", StyleBox["bword", FontWeight->"Bold", FontSlant->"Italic"], "\t\tThe K2K braid storage format, e.g. \"", StyleBox["bCCa", FontSlant->"Italic"], "\"", "\n", StyleBox["bridgeCount", FontWeight->"Bold", FontSlant->"Italic"], "\tThe number of \"bridges\" (arcs with at least 1 overpass between \ underpasses) in a diagram. Finding the ", StyleBox["bridgenumber", FontSlant->"Italic"], " (the minimum ", StyleBox["bridgeCount", FontSlant->"Italic"], ") is difficult.\n", StyleBox["Contact", FontWeight->"Bold"], "\tConsider a knotted tube. It can be \"worked-up\" until different parts \ come into contact. The \"zone of contact\" will depend on the tube \ properties. Tubes can be \"radially inelastic\" but not \"longitudinally \ inelastic\", as this would eliminate bends; \"springy\" or \"flexible\"; real \ tubes will have a coefficient of friction and a Young's modulus. Inelastic \ springy tubes will have point contacts; this will become a line for flexible \ tubes; soft tubes will deform to give an area. Real knots depend on the \ friction and elastic properties at their contacts for their effectiveness, \ and are very difficult to model. See [6, p323].\n", StyleBox["Chord\t", FontWeight->"Bold"], "\tA straight line between adjacent ", StyleBox["(w)xy(z)", FontSlant->"Italic"], " coordinates in a spacecurve. Created by ", StyleBox["curvs", FontSlant->"Italic"], " using piece-wise cubic interpolation between ", StyleBox["points", FontSlant->"Italic"], " in a ", StyleBox["linelist", FontSlant->"Italic"], ".\n", StyleBox["chordno", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["\t", FontSlant->"Italic"], "An option for ", StyleBox["curvs[pointlists]", FontSlant->"Italic"], " that (if integer>1) defines the number of ", StyleBox["chords", FontSlant->"Italic"], " between ", StyleBox["points", FontSlant->"Italic"], " or ", StyleBox["nodes", FontSlant->"Italic"], ". If real, it is the target length for the ", StyleBox["chords. ", FontSlant->"Italic"], "A value of 2 is recommended for fast ", StyleBox["Knot analysis", FontSlant->"Italic"], ".\n", StyleBox["Conway Notation.", FontWeight->"Bold"], " [9] A string of integers, with punctuation symbols in some cases, that \ define a link or knot in terms of a sequence of horizontal or vertical twists \ in a framework identified as 1*,6*, 6**, etc; the NW-NE and SW-SE ends are \ joined. [4,p44] gives an incomplete description, restricted to 1* knots. \ Implemented for some 1* cases by ", StyleBox["kconway", FontSlant->"Italic"], ". This gives the number of twists in sections that are alternately \ vertical and horizontal. \n", StyleBox["Coordinates\t", FontWeight->"Bold"], "(u,v,w,)x,y(,z) refer to the ends of chords. Each may have 3 or more \ dimensions. \n", StyleBox["Crossing", FontWeight->"Bold"], "\tTwo ", StyleBox["chords", FontSlant->"Italic"], " that cross in a 2D projection as a ", StyleBox["shadow", FontSlant->"Italic"], " or", StyleBox[" knot diagram", FontSlant->"Italic"], ". Converted to a ", StyleBox["node", FontSlant->"Italic"], " for knot analysis, and an ", StyleBox["edge", FontSlant->"Italic"], " in a knot graph.\n", StyleBox["Diagram", FontWeight->"Bold"], "\tA projection of a set of ", StyleBox["spacecurves", FontSlant->"Italic"], " onto two dimensions. It will normally have a number of ", StyleBox["crossings", FontSlant->"Italic"], ". It is a ", StyleBox["knot diagram", FontSlant->"Italic"], " if the nodes are signed to show under/over (and optional ", StyleBox["orientation", FontSlant->"Italic"], "); otherwise it is a ", StyleBox["shadow", FontSlant->"Italic"], ". \n", StyleBox["Direction", FontWeight->"Bold"], "\tThe sequence in which a ", StyleBox["spacecurve", FontSlant->"Italic"], " is traversed through the ", StyleBox["points", FontSlant->"Italic"], ".\n", StyleBox["Dowker-Thistlethwaite Name", FontWeight->"Bold"], StyleBox["\t", FontSlant->"Italic"], "The \"largest\" list of even-numbered nodes associated with the nodes \ {1,3,5...} in a node list, with the number negated if it is an undercrossing. \ This is extended to a list of lists to handle links. ", StyleBox["Dowth", FontSlant->"Italic"], " investigates different starting nodes to find the largest name. Multiple \ link starting nodes may need adjusting to avoid odd nodes in the name.\n", StyleBox["Hitch\t\"", FontWeight->"Bold"], "fastens a rope to objects of .. cylindrical form\" [2]\n", StyleBox["K2K", FontWeight->"Bold"], "\tKnots2000, Prof. Ochiai's package, downloadable from [13].", "\n", StyleBox["Knot\t", FontWeight->"Bold"], "A single 3D Loop that cannot be deformed to an ", StyleBox["unloop", FontSlant->"Italic"], "; this is the mathematical definition. The layman's knots include ", StyleBox["hitches", FontSlant->"Italic"], " & ", StyleBox["bends.\n", FontSlant->"Italic"], StyleBox["Knot Analysis", FontWeight->"Bold"], " Calculation of knot properties such as ", StyleBox["bridgeCount, writhe", FontSlant->"Italic"], " and knot invariants such as ", StyleBox["Jones polynomial", FontSlant->"Italic"], ". Various procedures operate on the signed node list ", StyleBox["nodeList", FontSlant->"Italic"], " which is created by ", StyleBox["crossings[]", FontSlant->"Italic"], " .\n", StyleBox["Knot Diagram ", FontWeight->"Bold"], "A 2.5D diagram with the over-line indicated at each crossing.", StyleBox["\n", FontWeight->"Bold"], StyleBox["k0m00n, ", FontWeight->"Bold", FontSlant->"Italic"], Cell[BoxData[ FormBox[ StyleBox[\(m\_n\), FontWeight->"Bold"], TraditionalForm]]], "\tThe n'th simple knot with m crossings in the standard list.\n", StyleBox["kgraf\t\t", FontWeight->"Bold", FontSlant->"Italic"], "A ", StyleBox["Combinatica", FontSlant->"Italic"], " knot graph produced by knotGraph, shown by ", StyleBox["ShowGraph[kgraf].", FontSlant->"Italic"], " Edges through +ve nodes are black, -ve red.", StyleBox["\nkgshow\t\t", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Show[kgshow]", FontSlant->"Italic"], " superimposes the knot graph on the knot shadow, with edges distorted to \ pass through the vertices.\n", StyleBox["knotGraph\t", FontWeight->"Bold"], "A set of vertices corresponding to the black regions in a chequered shadow \ (where the outside is white), joined by signed edges matching the oriented \ nodes that link the black regions. It is a planar graph that is dual to a \ link projection.\n", StyleBox["linkMatrix", FontWeight->"Bold", FontSlant->"Italic"], "\tA matrix of signed crossing counts between lines. The diagonal is the \ writhe for each line. Created by ", StyleBox["linkMatrix", FontSlant->"Italic"], "[] as part of the ", StyleBox["crosscurv", FontSlant->"Italic"], " output.\n", StyleBox["Loop", FontWeight->"Bold"], "\tA smooth continuous closed line in d dimensions. It is represented by a \ set of ", StyleBox["points", FontSlant->"Italic"], " with the last matching the first. (Unrelated to many other types of \ loop).\n", StyleBox["Link", FontWeight->"Bold"], "\tTwo or more ", StyleBox["loops", FontSlant->"Italic"], ".\n", StyleBox["Node", FontWeight->"Bold"], "\tA ", StyleBox["node", FontSlant->"Italic"], " is where two ", StyleBox["chords", FontSlant->"Italic"], " cross in a diagram. It has two indices, with indices counted from the \ first crossing. A ", StyleBox["nodeList", FontSlant->"Italic"], " is a sequential node list with the first index negated if it is the \ entering undercrossing and the second index negated if the node has a \ negative orientation.\n", StyleBox["Node Index", FontWeight->"Bold"], "\tThe position of a node in the list of nodes. A ", StyleBox["link", FontSlant->"Italic"], " with ", StyleBox["l", FontSlant->"Italic"], " loops has sequential indices for each loop, with implicit connection \ between its first and last indices.\n", StyleBox["n-strand Braid ", FontWeight->"Bold"], "\"n\" 3D lines moving across the page (down in [4] & [6]), forming one or \ more loops on closure by joining ends, right to left (or bottom to top). \ Created by ", StyleBox["braid[braidlist]", FontSlant->"Italic"], ".\n", StyleBox["nm-strand Weav", FontWeight->"Bold"], "e \"n\" 3D lines moving up the page, together with \"m\" 3D lines moving L \ to R across the page.\n", StyleBox["normalBraidList", FontWeight->"Bold", FontSlant->"Italic"], "\tA ", StyleBox["braidlist", FontSlant->"Italic"], " maximized by R1 & R2 moves and rotation.\n", StyleBox["oriented", FontWeight->"Bold"], "\tA knot or link is oriented when each line has a forward direction.\n", StyleBox["orientation", FontWeight->"Bold"], "\tA crossing is +ve if the incoming overcrossing is on the left when \ approaching along the incoming undercrossing. [4] pp19,152. [6] p33.\n", StyleBox["overcrossing", FontWeight->"Bold", FontSlant->"Italic"], "\tThe upper line at a crossing in a knot diagram.\n", StyleBox["Pretzel Link.", FontWeight->"Bold"], " A series of \"twisted pairs\" or \"tassels\", connected at top and \ bottom, that form a knot if there is an odd number of odd crossings (and no \ even crossings), or if only one has an even number of crossings. Two-tassel \ knots are circular knots. ", StyleBox["kpretzel", FontSlant->"Italic"], " creates pretzel knots. The Conway notation is the list of crossing \ numbers, separated by commas e.g 3,3,2 for k08005, which is generated by ", StyleBox["kpretzel[{3,3,2}]", FontSlant->"Italic"], ".\n", StyleBox["pword", FontWeight->"Bold"], "\tThe very compact knot descriptor in K2K [13], a list of link lengths \ followed by signed indices for the undercrossings.\n", StyleBox["Rational Link. ", FontWeight->"Bold"], "[5,p9]\n", StyleBox["Reidermeister Moves", FontWeight->"Bold"], " The three operations that change a diagram without changing topology. R1 \ removes or adds a crossing as an \[Alpha]. R2 removes or adds two crossing as \ a \[NotSubset]. R3 slides a line over or under an adjacent crossing without \ changing the number of crossings; |", StyleBox["\[Times]", FontSize->18], " \[DoubleLeftRightArrow] ", StyleBox["\[Times]", FontSize->18], "|.\n", StyleBox["ringbraid", FontWeight->"Bold", FontSlant->"Italic"], "\tA braid curved round and joined end-to-beginning as concentric circles \ with crossings. Created by ", StyleBox["ringbraid[braidlist]", FontSlant->"Italic"], ".\n", StyleBox["section", FontWeight->"Bold"], "\t\tThe part of a line joining two (adjacent) ", StyleBox["points", FontSlant->"Italic"], ". Identified by its initial and final point. Divided into ", StyleBox["chords", FontSlant->"Italic"], " by cubic interpolation.\n", StyleBox["segment", FontWeight->"Bold"], "\tThe part of a line joining two (adjacent) ", StyleBox["crossings ", FontSlant->"Italic"], "or", StyleBox[" nodes", FontSlant->"Italic"], ". Its ", StyleBox["Alternation", FontSlant->"Italic"], " is -ve if ends are under\[ShortRightArrow]under or \ over\[ShortRightArrow]over, +ve if they are different. Arcs and bridges are \ multiple segments. ", StyleBox["xyz", FontSlant->"Italic"], " gives the end-points of the chords describing the segment; these are \ found by ", StyleBox["crossings", FontSlant->"Italic"], " and need not match the original ", StyleBox["lineLis", FontSlant->"Italic"], "t points.\n", StyleBox["shadow\t", FontWeight->"Bold"], "A 2D projection in which the crossings are not distinguished as \ over/under.\n", StyleBox["Skein", FontWeight->"Bold"], "\t(Conway 1969) The structure used in many procedures, breaking an n-node \ diagram into ", Cell[BoxData[ \(TraditionalForm\`k\^n\)]], " unloops by opening each node in ", StyleBox["k", FontSlant->"Italic"], " ways, and calculating a (polynomial) function from the resulting \"states\ \".\n", StyleBox["Splice", FontWeight->"Bold"], "\tKauffman's [6] term for one of the two diagrams with one fewer crossing \ obtained by \"splicing\" and \"splitting\". Traditionally [2] a splice joins \ two ropes by interweaving the strands of the two ends.\n", StyleBox["Strand", FontWeight->"Bold"], "\t See Arc. Also the components of a braid or rope.\n", StyleBox["tangle ", FontWeight->"Bold"], "\tA specialist term for a closed part of a knot diagram. An n-tangle has \ exactly n free ends. 4-tangles are used in Conway's notation.\n", StyleBox["tassel.", FontWeight->"Bold"], " (US, tassle in English) The term used in Lickorish [5,p8] for the \ sections of a pretzel or rational link.\n", StyleBox["tricolourable", FontWeight->"Bold"], " If the arcs (strands) can be assigned three colours so that every \ crossing involves 1 or 3 colours.\n", StyleBox["undercrossing", FontWeight->"Bold"], "\tThe lower line at a crossing in a knot diagram.\n", StyleBox["Writhe", FontWeight->"Bold"], "\t The number of nodes with positive orientation minus the number with \ negative orientation in a knot or link. The ", StyleBox["linkMatrix", FontSlant->"Italic"], " diagonal is the writhe of each line in a link." }], "Text", PageWidth->PaperWidth] }, Closed]] }, Open ]] }, FrontEndVersion->"5.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 685}}, AutoGeneratedPackage->Automatic, WindowToolbars->"EditBar", WindowSize->{782, 638}, WindowMargins->{{49, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, PageHeaders->{{None, Inherited, None}, {None, Inherited, None}}, PageFooters->{{Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"], Cell[ TextData[ "3rd Oct. 1998"]], Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"]}, {Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"], Cell[ TextData[ "24/8/5"]], Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"]}}, PageHeaderLines->{False, False}, PrintingOptions->{"FirstPageFooter"->False}, Magnification->1.5 ] (******************************************************************* 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, 155, 7, 121, "Title"], Cell[1934, 62, 116, 2, 62, "Subtitle"], Cell[2053, 66, 194, 6, 67, "Subsubtitle"], Cell[2250, 74, 887, 15, 318, "Text"], Cell[3140, 91, 344, 8, 97, "Input", InitializationCell->True], Cell[3487, 101, 341, 11, 76, "Text"], Cell[3831, 114, 1211, 23, 28, "Input", CellOpen->False], Cell[5045, 139, 308, 9, 65, "Text"], Cell[5356, 150, 121, 4, 43, "Text"], Cell[CellGroupData[{ Cell[5502, 158, 76, 2, 106, "Section"], Cell[CellGroupData[{ Cell[5603, 164, 40, 0, 66, "Subsection"], Cell[5646, 166, 1175, 30, 285, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[6858, 201, 54, 0, 66, "Subsection"], Cell[6915, 203, 1469, 37, 405, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[8421, 245, 46, 0, 66, "Subsection"], Cell[8470, 247, 2357, 44, 717, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[10864, 296, 68, 1, 66, "Subsection"], Cell[10935, 299, 3458, 107, 693, "Text"], Cell[14396, 408, 88, 2, 54, "Input"], Cell[14487, 412, 119, 3, 54, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[14643, 420, 62, 1, 66, "Subsection"], Cell[14708, 423, 415, 9, 189, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[15172, 438, 72, 2, 59, "Section"], Cell[CellGroupData[{ Cell[15269, 444, 92, 1, 56, "Subsection"], Cell[15364, 447, 690, 20, 165, "Text"], Cell[16057, 469, 1370, 40, 150, "Input"], Cell[17430, 511, 1243, 34, 285, "Text"], Cell[18676, 547, 285, 8, 69, "Input"], Cell[18964, 557, 1254, 34, 285, "Text"], Cell[20221, 593, 1003, 24, 312, "Input"], Cell[21227, 619, 498, 15, 117, "Text"], Cell[21728, 636, 386, 9, 123, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[22151, 650, 92, 1, 42, "Subsection"], Cell[22246, 653, 553, 10, 165, "Text"], Cell[22802, 665, 280, 5, 150, "Input"], Cell[23085, 672, 342, 6, 150, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[23464, 683, 79, 1, 42, "Subsection"], Cell[23546, 686, 1205, 28, 309, "Text"], Cell[24754, 716, 420, 7, 177, "Input"], Cell[25177, 725, 463, 11, 141, "Text"], Cell[25643, 738, 562, 10, 312, "Input"], Cell[26208, 750, 519, 18, 117, "Text"], Cell[26730, 770, 423, 9, 117, "Text"], Cell[27156, 781, 147, 3, 69, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[27340, 789, 68, 1, 42, "Subsection"], Cell[27411, 792, 398, 7, 141, "Text"], Cell[27812, 801, 207, 4, 96, "Input"], Cell[28022, 807, 1230, 32, 261, "Text"], Cell[29255, 841, 339, 6, 150, "Input"], Cell[29597, 849, 391, 9, 117, "Text"], Cell[29991, 860, 206, 4, 69, "Input"], Cell[30200, 866, 247, 5, 93, "Text"], Cell[30450, 873, 389, 7, 204, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[30876, 885, 58, 1, 42, "Subsection"], Cell[30937, 888, 1778, 26, 549, "Text"], Cell[32718, 916, 164, 4, 54, "Input", Evaluatable->False], Cell[32885, 922, 886, 16, 327, "Input"], Cell[33774, 940, 253, 5, 93, "Text"], Cell[34030, 947, 149, 3, 69, "Input"], Cell[34182, 952, 384, 7, 141, "Text"], Cell[34569, 961, 242, 5, 96, "Input", Evaluatable->False], Cell[34814, 968, 1354, 24, 28, "Input", CellOpen->False], Cell[36171, 994, 935, 15, 333, "Text"], Cell[37109, 1011, 198, 4, 54, "Input", Evaluatable->False], Cell[37310, 1017, 956, 18, 28, "Input", CellOpen->False], Cell[38269, 1037, 409, 7, 141, "Text"], Cell[38681, 1046, 1312, 20, 429, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[40030, 1071, 78, 1, 42, "Subsection"], Cell[40111, 1074, 485, 8, 165, "Text"], Cell[40599, 1084, 267, 5, 69, "Input", Evaluatable->False], Cell[40869, 1091, 593, 12, 28, "Input", CellOpen->False], Cell[41465, 1105, 259, 5, 69, "Input", Evaluatable->False], Cell[41727, 1112, 425, 9, 28, "Input", CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell[42189, 1126, 58, 1, 42, "Subsection"], Cell[42250, 1129, 775, 26, 141, "Text"], Cell[43028, 1157, 165, 3, 54, "Input", Evaluatable->False], Cell[43196, 1162, 430, 8, 28, "Input", CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell[43663, 1175, 92, 1, 42, "Subsection"], Cell[43758, 1178, 3138, 78, 741, "Text"], Cell[46899, 1258, 657, 13, 339, "Input"], Cell[47559, 1273, 332, 7, 177, "Input"], Cell[47894, 1282, 630, 15, 177, "Input"], Cell[48527, 1299, 602, 13, 177, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[49166, 1317, 80, 1, 42, "Subsection"], Cell[49249, 1320, 1086, 19, 333, "Text"], Cell[50338, 1341, 341, 7, 146, "Input"], Cell[50682, 1350, 285, 6, 120, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[51004, 1361, 62, 1, 42, "Subsection"], Cell[51069, 1364, 384, 7, 141, "Text"], Cell[51456, 1373, 183, 4, 54, "Input", Evaluatable->False], Cell[51642, 1379, 2452, 47, 28, "Input", CellOpen->False], Cell[54097, 1428, 434, 11, 117, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[54568, 1444, 78, 1, 42, "Subsection"], Cell[54649, 1447, 368, 9, 117, "Text"], Cell[55020, 1458, 300, 5, 150, "Input"], Cell[55323, 1465, 277, 5, 123, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[55637, 1475, 76, 1, 42, "Subsection"], Cell[55716, 1478, 2127, 53, 541, "Text"], Cell[57846, 1533, 195, 4, 42, "Input", Evaluatable->False], Cell[58044, 1539, 521, 8, 250, "Input"], Cell[58568, 1549, 834, 23, 203, "Text"], Cell[59405, 1574, 168, 3, 42, "Input", Evaluatable->False], Cell[59576, 1579, 17591, 374, 28, "Input", CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell[77204, 1958, 83, 1, 56, "Subsection"], Cell[77290, 1961, 2390, 36, 765, "Text"], Cell[79683, 1999, 401, 7, 177, "Input"], Cell[80087, 2008, 197, 7, 69, "Text"], Cell[80287, 2017, 288, 6, 96, "Input", Evaluatable->False], Cell[80578, 2025, 820, 19, 28, "Input", CellOpen->False], Cell[81401, 2046, 179, 4, 69, "Input", Evaluatable->False], Cell[81583, 2052, 1797, 44, 28, "Input", CellOpen->False], Cell[83383, 2098, 246, 9, 69, "Text"], Cell[83632, 2109, 365, 7, 177, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[84034, 2121, 67, 1, 42, "Subsection"], Cell[84104, 2124, 253, 9, 73, "Text"], Cell[CellGroupData[{ Cell[84382, 2137, 90, 1, 40, "Subsubsection"], Cell[84475, 2140, 1423, 33, 429, "Text"], Cell[CellGroupData[{ Cell[85923, 2177, 168, 4, 69, "Input"], Cell[86094, 2183, 50, 1, 54, "Output"] }, Closed]], Cell[86159, 2187, 291, 6, 93, "Text"], Cell[CellGroupData[{ Cell[86475, 2197, 144, 3, 69, "Input"], Cell[86622, 2202, 141, 2, 54, "Output"] }, Closed]], Cell[86778, 2207, 227, 5, 93, "Text"], Cell[87008, 2214, 192, 3, 96, "Input"], Cell[87203, 2219, 54, 1, 54, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[87294, 2225, 82, 1, 29, "Subsubsection"], Cell[87379, 2228, 349, 12, 69, "Text"], Cell[87731, 2242, 488, 9, 231, "Input"], Cell[88222, 2253, 69, 0, 57, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[88328, 2258, 94, 1, 29, "Subsubsection"], Cell[88425, 2261, 362, 13, 99, "Text"], Cell[88790, 2276, 437, 8, 224, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[89264, 2289, 92, 1, 40, "Subsubsection"], Cell[89359, 2292, 106, 3, 47, "Text"], Cell[89468, 2297, 241, 4, 120, "Input"], Cell[89712, 2303, 413, 14, 99, "Text"], Cell[90128, 2319, 245, 4, 146, "Input"], Cell[90376, 2325, 476, 12, 125, "Text"], Cell[90855, 2339, 867, 18, 328, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[91771, 2363, 78, 1, 56, "Subsection"], Cell[91852, 2366, 673, 12, 203, "Text"], Cell[92528, 2380, 647, 13, 224, "Input"], Cell[93178, 2395, 463, 14, 99, "Text"], Cell[93644, 2411, 702, 13, 250, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[94395, 2430, 120, 2, 142, "Section"], Cell[CellGroupData[{ Cell[94540, 2436, 157, 5, 56, "Subsection"], Cell[CellGroupData[{ Cell[94722, 2445, 158, 5, 54, "Subsubsection"], Cell[94883, 2452, 219, 4, 123, "Input"], Cell[95105, 2458, 17532, 389, 1419, "Input", InitializationCell->True], Cell[112640, 2849, 704, 16, 312, "Input", InitializationCell->True], Cell[113347, 2867, 2368, 58, 258, "Input", InitializationCell->True], Cell[115718, 2927, 2320, 56, 258, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[118075, 2988, 142, 5, 54, "Subsubsection"], Cell[118220, 2995, 1538, 44, 258, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[119807, 3045, 126, 6, 42, "Subsection"], Cell[CellGroupData[{ Cell[119958, 3055, 134, 6, 54, "Subsubsection"], Cell[120095, 3063, 14659, 316, 2238, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[134803, 3385, 133, 5, 42, "Subsection"], Cell[CellGroupData[{ Cell[134961, 3394, 155, 6, 54, "Subsubsection"], Cell[135119, 3402, 84, 2, 54, "Input"], Cell[135206, 3406, 538, 13, 177, "Input", InitializationCell->True], Cell[135747, 3421, 3392, 76, 735, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[139188, 3503, 144, 6, 42, "Subsection"], Cell[CellGroupData[{ Cell[139357, 3513, 149, 6, 54, "Subsubsection"], Cell[139509, 3521, 87, 2, 54, "Input"], Cell[139599, 3525, 470, 11, 177, "Input", InitializationCell->True], Cell[140072, 3538, 5809, 116, 1068, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[145918, 3659, 192, 8, 54, "Subsubsection"], Cell[146113, 3669, 94, 2, 54, "Input"], Cell[146210, 3673, 618, 16, 150, "Input", InitializationCell->True], Cell[146831, 3691, 1772, 39, 393, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[148652, 3736, 191, 9, 42, "Subsection"], Cell[148846, 3747, 358, 7, 117, "Text"], Cell[149207, 3756, 2667, 58, 771, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[151911, 3819, 216, 9, 42, "Subsection"], Cell[CellGroupData[{ Cell[152152, 3832, 55, 0, 54, "Subsubsection"], Cell[152210, 3834, 3592, 82, 909, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[155839, 3921, 180, 7, 54, "Subsubsection"], Cell[156022, 3930, 119, 3, 69, "Input"], Cell[156144, 3935, 6707, 135, 1230, "Input", InitializationCell->True], Cell[162854, 4072, 4197, 93, 798, "Input", InitializationCell->True], Cell[167054, 4167, 10487, 206, 1878, "Input", InitializationCell->True], Cell[177544, 4375, 11609, 246, 1986, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[189190, 4626, 175, 7, 54, "Subsubsection"], Cell[189368, 4635, 924, 16, 357, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[190329, 4656, 73, 1, 54, "Subsubsection"], Cell[190405, 4659, 836, 13, 285, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[191290, 4678, 240, 10, 42, "Subsection", InitializationCell->True], Cell[191533, 4690, 174, 5, 69, "Text", InitializationCell->True], Cell[191710, 4697, 132, 3, 69, "Input"], Cell[191845, 4702, 381, 10, 123, "Input", InitializationCell->True], Cell[192229, 4714, 467, 13, 108, "Input", InitializationCell->True], Cell[192699, 4729, 416, 12, 84, "Input", InitializationCell->True], Cell[193118, 4743, 472, 13, 108, "Input", InitializationCell->True], Cell[193593, 4758, 421, 12, 84, "Input", InitializationCell->True], Cell[194017, 4772, 467, 13, 108, "Input", InitializationCell->True], Cell[194487, 4787, 416, 12, 84, "Input", InitializationCell->True], Cell[194906, 4801, 765, 21, 69, "Input", InitializationCell->True], Cell[195674, 4824, 765, 21, 69, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[196476, 4850, 291, 13, 42, "Subsection", InitializationCell->True], Cell[196770, 4865, 394, 11, 93, "Text"], Cell[CellGroupData[{ Cell[197189, 4880, 115, 2, 54, "Subsubsection"], Cell[197307, 4884, 349, 12, 69, "Text"], Cell[197659, 4898, 76, 1, 54, "Input"], Cell[197738, 4901, 3547, 76, 582, "Input", InitializationCell->True], Cell[201288, 4979, 17428, 310, 4362, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[218753, 5294, 102, 2, 54, "Subsubsection"], Cell[218858, 5298, 649, 15, 189, "Text"], Cell[219510, 5315, 6421, 123, 1392, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[225980, 5444, 266, 8, 94, "Subsection"], Cell[226249, 5454, 1450, 44, 333, "Text"], Cell[CellGroupData[{ Cell[227724, 5502, 213, 5, 120, "Input", InitializationCell->True], Cell[227940, 5509, 96, 2, 54, "Output"] }, Closed]], Cell[228051, 5514, 471, 14, 118, "Text"], Cell[228525, 5530, 367, 8, 146, "Input", InitializationCell->True], Cell[228895, 5540, 215, 5, 73, "Text"], Cell[229113, 5547, 327, 7, 146, "Input", InitializationCell->True], Cell[229443, 5556, 177, 7, 47, "Text"], Cell[229623, 5565, 185, 5, 94, "Input", InitializationCell->True], Cell[229811, 5572, 821, 15, 276, "Input", InitializationCell->True], Cell[230635, 5589, 223, 5, 94, "Input", InitializationCell->True], Cell[230861, 5596, 173, 4, 73, "Text"], Cell[231037, 5602, 943, 17, 406, "Input", InitializationCell->True], Cell[231983, 5621, 1570, 27, 614, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[233602, 5654, 86, 2, 59, "Section"], Cell[CellGroupData[{ Cell[233713, 5660, 91, 1, 66, "Subsection"], Cell[233807, 5663, 2375, 45, 669, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[236219, 5713, 76, 1, 66, "Subsection"], Cell[CellGroupData[{ Cell[236320, 5718, 43, 0, 54, "Subsubsection"], Cell[236366, 5720, 1995, 60, 381, "Text"], Cell[238364, 5782, 2624, 67, 669, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[241025, 5854, 126, 5, 54, "Subsubsection"], Cell[241154, 5861, 105, 2, 69, "Input"], Cell[241262, 5865, 618, 16, 150, "Input", InitializationCell->True], Cell[241883, 5883, 8781, 218, 231, "Input", InitializationCell->True], Cell[250667, 6103, 20342, 379, 3444, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[271058, 6488, 90, 1, 66, "Subsection"], Cell[CellGroupData[{ Cell[271173, 6493, 43, 0, 54, "Subsubsection"], Cell[271219, 6495, 735, 12, 261, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[271991, 6512, 113, 5, 54, "Subsubsection"], Cell[272107, 6519, 97, 2, 54, "Input"], Cell[272207, 6523, 3382, 72, 636, "Input", InitializationCell->True], Cell[275592, 6597, 885, 21, 231, "Input", InitializationCell->True], Cell[276480, 6620, 370, 8, 117, "Text"], Cell[276853, 6630, 4622, 95, 798, "Input", InitializationCell->True], Cell[281478, 6727, 366, 7, 117, "Text"], Cell[281847, 6736, 5222, 110, 1014, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[287118, 6852, 124, 3, 84, "Subsection"], Cell[CellGroupData[{ Cell[287267, 6859, 43, 0, 54, "Subsubsection"], Cell[287313, 6861, 1091, 23, 309, "Text"], Cell[288407, 6886, 121, 2, 69, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[288565, 6893, 146, 5, 54, "Subsubsection"], Cell[288714, 6900, 120, 3, 69, "Input"], Cell[288837, 6905, 241, 7, 54, "Input", InitializationCell->True], Cell[289081, 6914, 2114, 50, 447, "Input"], Cell[291198, 6966, 2177, 52, 393, "Input", InitializationCell->True], Cell[293378, 7020, 1349, 30, 393, "Input", InitializationCell->True], Cell[294730, 7052, 263, 7, 69, "Text"], Cell[294996, 7061, 700, 20, 150, "Input", InitializationCell->True], Cell[295699, 7083, 700, 19, 123, "Input", InitializationCell->True], Cell[296402, 7104, 913, 23, 258, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[297364, 7133, 64, 1, 66, "Subsection"], Cell[CellGroupData[{ Cell[297453, 7138, 43, 0, 54, "Subsubsection"], Cell[297499, 7140, 1625, 40, 405, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[299161, 7185, 105, 5, 54, "Subsubsection"], Cell[299269, 7192, 408, 7, 177, "Input", InitializationCell->True], Cell[299680, 7201, 64, 1, 54, "Input"], Cell[299747, 7204, 7313, 154, 1608, "Input", InitializationCell->True], Cell[307063, 7360, 2840, 101, 453, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[309952, 7467, 93, 1, 66, "Subsection"], Cell[310048, 7470, 909, 17, 285, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[311006, 7493, 106, 2, 59, "Section"], Cell[311115, 7497, 212, 7, 69, "Text"], Cell[CellGroupData[{ Cell[311352, 7508, 50, 0, 66, "Subsection"], Cell[311405, 7510, 178, 5, 54, "Input", InitializationCell->True], Cell[311586, 7517, 200, 5, 54, "Input", InitializationCell->True], Cell[311789, 7524, 341, 7, 87, "Input", InitializationCell->True], Cell[312133, 7533, 348, 7, 111, "Input", InitializationCell->True], Cell[312484, 7542, 459, 9, 111, "Input", InitializationCell->True], Cell[312946, 7553, 542, 10, 135, "Input", InitializationCell->True], Cell[313491, 7565, 268, 6, 63, "Input", InitializationCell->True], Cell[313762, 7573, 346, 7, 87, "Input", InitializationCell->True], Cell[314111, 7582, 316, 7, 111, "Input", InitializationCell->True], Cell[314430, 7591, 346, 7, 87, "Input", InitializationCell->True], Cell[314779, 7600, 574, 11, 159, "Input", InitializationCell->True], Cell[315356, 7613, 452, 9, 111, "Input", InitializationCell->True], Cell[315811, 7624, 494, 9, 135, "Input", InitializationCell->True], Cell[316308, 7635, 642, 12, 159, "Input", InitializationCell->True], Cell[316953, 7649, 434, 8, 111, "Input", InitializationCell->True], Cell[317390, 7659, 502, 10, 111, "Input", InitializationCell->True], Cell[317895, 7671, 638, 11, 135, "Input", InitializationCell->True], Cell[318536, 7684, 203, 5, 54, "Input", InitializationCell->True], Cell[318742, 7691, 223, 5, 63, "Input", InitializationCell->True], Cell[318968, 7698, 243, 6, 63, "Input", InitializationCell->True], Cell[319214, 7706, 419, 8, 111, "Input", InitializationCell->True], Cell[319636, 7716, 487, 9, 135, "Input", InitializationCell->True], Cell[320126, 7727, 505, 9, 159, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[320668, 7741, 33, 0, 66, "Subsection"], Cell[320704, 7743, 402, 8, 111, "Input", InitializationCell->True], Cell[321109, 7753, 803, 14, 207, "Input", InitializationCell->True], Cell[321915, 7769, 811, 14, 207, "Input", InitializationCell->True], Cell[322729, 7785, 812, 14, 183, "Input", InitializationCell->True], Cell[323544, 7801, 962, 17, 231, "Input", InitializationCell->True], Cell[324509, 7820, 552, 10, 135, "Input", InitializationCell->True], Cell[325064, 7832, 953, 17, 231, "Input", InitializationCell->True], Cell[326020, 7851, 646, 12, 183, "Input", InitializationCell->True], Cell[326669, 7865, 524, 11, 159, "Input", InitializationCell->True], Cell[327196, 7878, 776, 14, 207, "Input", InitializationCell->True], Cell[327975, 7894, 914, 16, 231, "Input", InitializationCell->True], Cell[328892, 7912, 1053, 18, 279, "Input", InitializationCell->True], Cell[329948, 7932, 869, 16, 231, "Input", InitializationCell->True], Cell[330820, 7950, 941, 18, 231, "Input", InitializationCell->True], Cell[331764, 7970, 856, 15, 207, "Input", InitializationCell->True], Cell[332623, 7987, 1126, 19, 351, "Input", InitializationCell->True], Cell[333752, 8008, 105, 2, 54, "Input"], Cell[333860, 8012, 676, 12, 159, "Input", InitializationCell->True], Cell[334539, 8026, 688, 13, 159, "Input", InitializationCell->True], Cell[335230, 8041, 793, 15, 183, "Input", InitializationCell->True], Cell[336026, 8058, 971, 19, 255, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[337034, 8082, 52, 0, 66, "Subsection"], Cell[337089, 8084, 634, 11, 183, "Input", InitializationCell->True], Cell[337726, 8097, 754, 13, 207, "Input", InitializationCell->True], Cell[338483, 8112, 396, 8, 111, "Input", InitializationCell->True], Cell[338882, 8122, 1324, 22, 351, "Input", InitializationCell->True], Cell[340209, 8146, 3149, 49, 735, "Input", InitializationCell->True], Cell[343361, 8197, 3130, 47, 735, "Input", InitializationCell->True], Cell[346494, 8246, 733, 16, 183, "Input", InitializationCell->True], Cell[347230, 8264, 927, 17, 255, "Input", InitializationCell->True], Cell[348160, 8283, 1103, 19, 255, "Input", InitializationCell->True], Cell[349266, 8304, 57, 0, 57, "Text"], Cell[349326, 8306, 541, 10, 135, "Input", InitializationCell->True], Cell[349870, 8318, 921, 17, 231, "Input", InitializationCell->True], Cell[350794, 8337, 269, 5, 93, "Text"], Cell[351066, 8344, 671, 12, 183, "Input", InitializationCell->True], Cell[351740, 8358, 241, 5, 93, "Text"], Cell[351984, 8365, 879, 15, 231, "Input", InitializationCell->True], Cell[352866, 8382, 162, 4, 69, "Text"], Cell[353031, 8388, 718, 14, 159, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[353786, 8407, 95, 2, 66, "Subsection"], Cell[353884, 8411, 283, 6, 87, "Input", InitializationCell->True], Cell[354170, 8419, 258, 6, 87, "Input", InitializationCell->True], Cell[354431, 8427, 349, 7, 111, "Input", InitializationCell->True], Cell[354783, 8436, 380, 7, 111, "Input", InitializationCell->True], Cell[355166, 8445, 396, 8, 111, "Input", InitializationCell->True], Cell[355565, 8455, 634, 12, 255, "Input"], Cell[356202, 8469, 524, 10, 159, "Input", InitializationCell->True], Cell[356729, 8481, 249, 5, 63, "Input"], Cell[356981, 8488, 714, 12, 207, "Input", InitializationCell->True], Cell[357698, 8502, 252, 5, 63, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[357999, 8513, 424, 21, 101, "Section"], Cell[CellGroupData[{ Cell[358448, 8538, 40, 0, 66, "Subsection"], Cell[358491, 8540, 1703, 62, 285, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[360231, 8607, 64, 0, 66, "Subsection"], Cell[360298, 8609, 213, 6, 63, "Input", InitializationCell->True], Cell[360514, 8617, 410, 8, 135, "Input", InitializationCell->True], Cell[360927, 8627, 300, 6, 87, "Input", InitializationCell->True], Cell[361230, 8635, 385, 9, 111, "Input", InitializationCell->True], Cell[361618, 8646, 399, 8, 87, "Input", InitializationCell->True], Cell[362020, 8656, 1217, 20, 399, "Input", InitializationCell->True], Cell[363240, 8678, 628, 15, 255, "Input", InitializationCell->True], Cell[363871, 8695, 33, 0, 57, "Text"], Cell[363907, 8697, 654, 13, 207, "Input", InitializationCell->True], Cell[364564, 8712, 756, 15, 231, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[365357, 8732, 58, 0, 66, "Subsection"], Cell[365418, 8734, 879, 17, 207, "Input", InitializationCell->True], Cell[366300, 8753, 120, 4, 54, "Input", InitializationCell->True], Cell[366423, 8759, 514, 10, 111, "Input", InitializationCell->True], Cell[366940, 8771, 587, 11, 135, "Input", InitializationCell->True], Cell[367530, 8784, 568, 10, 135, "Input", InitializationCell->True], Cell[368101, 8796, 503, 9, 135, "Input", InitializationCell->True], Cell[368607, 8807, 510, 9, 111, "Input", InitializationCell->True], Cell[369120, 8818, 534, 10, 135, "Input", InitializationCell->True], Cell[369657, 8830, 1572, 26, 543, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[371266, 8861, 58, 0, 66, "Subsection"], Cell[371327, 8863, 5255, 85, 1815, "Input", InitializationCell->True], Cell[376585, 8950, 648, 11, 183, "Input", InitializationCell->True], Cell[377236, 8963, 572, 10, 135, "Input", InitializationCell->True], Cell[377811, 8975, 672, 12, 159, "Input", InitializationCell->True], Cell[378486, 8989, 784, 14, 183, "Input", InitializationCell->True], Cell[379273, 9005, 577, 10, 135, "Input", InitializationCell->True], Cell[379853, 9017, 354, 8, 111, "Input", InitializationCell->True], Cell[380210, 9027, 658, 12, 159, "Input", InitializationCell->True], Cell[380871, 9041, 575, 11, 135, "Input", InitializationCell->True], Cell[381449, 9054, 528, 10, 111, "Input", InitializationCell->True], Cell[381980, 9066, 600, 11, 159, "Input", InitializationCell->True], Cell[382583, 9079, 674, 12, 183, "Input", InitializationCell->True], Cell[383260, 9093, 704, 13, 159, "Input", InitializationCell->True], Cell[383967, 9108, 616, 11, 135, "Input", InitializationCell->True], Cell[384586, 9121, 643, 11, 159, "Input", InitializationCell->True], Cell[385232, 9134, 602, 11, 135, "Input", InitializationCell->True], Cell[385837, 9147, 604, 11, 135, "Input", InitializationCell->True], Cell[386444, 9160, 616, 11, 135, "Input", InitializationCell->True], Cell[387063, 9173, 503, 9, 135, "Input", InitializationCell->True], Cell[387569, 9184, 536, 9, 135, "Input", InitializationCell->True], Cell[388108, 9195, 560, 10, 135, "Input", InitializationCell->True], Cell[388671, 9207, 530, 9, 135, "Input", InitializationCell->True], Cell[389204, 9218, 540, 10, 135, "Input", InitializationCell->True], Cell[389747, 9230, 612, 11, 183, "Input"], Cell[390362, 9243, 527, 9, 135, "Input", InitializationCell->True], Cell[390892, 9254, 668, 12, 159, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[391597, 9271, 66, 0, 66, "Subsection"], Cell[391666, 9273, 53, 0, 57, "Text"], Cell[391722, 9275, 995, 18, 255, "Input", InitializationCell->True], Cell[392720, 9295, 95, 2, 57, "Text"], Cell[392818, 9299, 739, 14, 183, "Input", InitializationCell->True], Cell[393560, 9315, 739, 14, 183, "Input", InitializationCell->True], Cell[394302, 9331, 758, 14, 183, "Input", InitializationCell->True], Cell[395063, 9347, 1021, 18, 303, "Input", InitializationCell->True], Cell[396087, 9367, 131, 4, 57, "Text"], Cell[396221, 9373, 956, 17, 303, "Input", InitializationCell->True], Cell[397180, 9392, 1030, 19, 303, "Input", InitializationCell->True], Cell[398213, 9413, 904, 17, 279, "Input", InitializationCell->True], Cell[399120, 9432, 144, 5, 57, "Text"], Cell[399267, 9439, 1240, 22, 327, "Input", InitializationCell->True], Cell[400510, 9463, 1100, 19, 327, "Input", InitializationCell->True], Cell[401613, 9484, 1020, 18, 303, "Input", InitializationCell->True], Cell[402636, 9504, 1120, 19, 279, "Input", InitializationCell->True], Cell[403759, 9525, 197, 5, 63, "Text"], Cell[403959, 9532, 1076, 19, 303, "Input", InitializationCell->True], Cell[405038, 9553, 673, 13, 231, "Input"], Cell[405714, 9568, 660, 13, 231, "Input"], Cell[406377, 9583, 438, 9, 135, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[406852, 9597, 33, 0, 66, "Subsection"], Cell[406888, 9599, 297, 6, 96, "Input", InitializationCell->True], Cell[407188, 9607, 316, 7, 111, "Input", InitializationCell->True], Cell[407507, 9616, 439, 9, 135, "Input"], Cell[407949, 9627, 59, 1, 57, "Text"], Cell[408011, 9630, 671, 11, 183, "Input", InitializationCell->True], Cell[408685, 9643, 1357, 25, 375, "Input"], Cell[410045, 9670, 162, 5, 57, "Text"], Cell[410210, 9677, 542, 10, 135, "Input", InitializationCell->True], Cell[410755, 9689, 819, 16, 231, "Input"], Cell[411577, 9707, 179, 5, 63, "Text"], Cell[411759, 9714, 1786, 28, 519, "Input", InitializationCell->True], Cell[413548, 9744, 1850, 31, 543, "Input"], Cell[415401, 9777, 57, 1, 57, "Text"], Cell[415461, 9780, 475, 10, 111, "Input", InitializationCell->True], Cell[415939, 9792, 72, 1, 57, "Text"], Cell[416014, 9795, 1673, 32, 447, "Input", InitializationCell->True], Cell[417690, 9829, 66, 1, 57, "Text"], Cell[417759, 9832, 691, 13, 207, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[418487, 9850, 165, 6, 66, "Subsection"], Cell[418655, 9858, 583, 10, 189, "Text"], Cell[419241, 9870, 439, 7, 231, "Input"], Cell[419683, 9879, 118, 3, 54, "Input", InitializationCell->True], Cell[419804, 9884, 525, 10, 159, "Input", InitializationCell->True], Cell[420332, 9896, 898, 16, 255, "Input", InitializationCell->True], Cell[421233, 9914, 1724, 28, 495, "Input", InitializationCell->True], Cell[422960, 9944, 3834, 61, 1023, "Input", InitializationCell->True], Cell[426797, 10007, 9819, 150, 2727, "Input", InitializationCell->True], Cell[436619, 10159, 22214, 348, 5751, "Input", InitializationCell->True], Cell[458836, 10509, 315, 8, 93, "Text"], Cell[459154, 10519, 17759, 289, 5079, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[476938, 10812, 120, 5, 54, "Subsubsection"], Cell[477061, 10819, 140, 3, 69, "Input"], Cell[477204, 10824, 135, 4, 69, "Text"], Cell[477342, 10830, 510, 9, 258, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[477913, 10846, 67, 1, 62, "Section"], Cell[477983, 10849, 380, 11, 117, "Text"], Cell[478366, 10862, 364, 7, 87, "Input", InitializationCell->True], Cell[478733, 10871, 417, 8, 87, "Input", InitializationCell->True], Cell[479153, 10881, 285, 6, 63, "Input", InitializationCell->True], Cell[479441, 10889, 334, 7, 63, "Input", InitializationCell->True], Cell[479778, 10898, 617, 12, 159, "Input", InitializationCell->True], Cell[480398, 10912, 896, 16, 231, "Input", InitializationCell->True], Cell[481297, 10930, 572, 11, 135, "Input", InitializationCell->True], Cell[481872, 10943, 505, 9, 135, "Input", InitializationCell->True], Cell[482380, 10954, 509, 9, 135, "Input", InitializationCell->True], Cell[482892, 10965, 321, 7, 63, "Input", InitializationCell->True], Cell[483216, 10974, 342, 7, 63, "Input", InitializationCell->True], Cell[483561, 10983, 535, 10, 111, "Input", InitializationCell->True], Cell[484099, 10995, 376, 7, 87, "Input", InitializationCell->True], Cell[484478, 11004, 380, 7, 135, "Input", InitializationCell->True], Cell[484861, 11013, 983, 16, 231, "Input", InitializationCell->True], Cell[485847, 11031, 401, 8, 111, "Input", InitializationCell->True], Cell[486251, 11041, 523, 9, 159, "Input", InitializationCell->True], Cell[486777, 11052, 1007, 18, 231, "Input", InitializationCell->True], Cell[487787, 11072, 1683, 27, 375, "Input", InitializationCell->True], Cell[489473, 11101, 552, 10, 135, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[490062, 11116, 120, 2, 62, "Section", InitializationCell->True], Cell[CellGroupData[{ Cell[490207, 11122, 32, 0, 66, "Subsection"], Cell[490242, 11124, 1328, 29, 123, "Input"], Cell[491573, 11155, 1717, 36, 150, "Input"], Cell[493293, 11193, 1068, 24, 123, "Input", InitializationCell->True], Cell[494364, 11219, 2632, 54, 204, "Input", InitializationCell->True], Cell[496999, 11275, 746, 14, 231, "Input", InitializationCell->True], Cell[497748, 11291, 943, 20, 123, "Input"], Cell[498694, 11313, 673, 13, 231, "Input", InitializationCell->True], Cell[499370, 11328, 10870, 223, 501, "Input", InitializationCell->True], Cell[510243, 11553, 5534, 115, 231, "Input", InitializationCell->True], Cell[515780, 11670, 16793, 339, 1176, "Input", InitializationCell->True], Cell[532576, 12011, 1022, 21, 123, "Input", InitializationCell->True], Cell[533601, 12034, 347, 8, 96, "Input", InitializationCell->True], Cell[533951, 12044, 565, 11, 204, "Input", InitializationCell->True], Cell[534519, 12057, 3061, 58, 744, "Input", InitializationCell->True], Cell[537583, 12117, 3527, 67, 582, "Input", InitializationCell->True], Cell[541113, 12186, 255, 5, 114, "Input"], Cell[541371, 12193, 1823, 38, 150, "Input", InitializationCell->True], Cell[543197, 12233, 579, 11, 285, "Input", InitializationCell->True], Cell[543779, 12246, 688, 14, 150, "Input", InitializationCell->True], Cell[544470, 12262, 634, 13, 177, "Input", InitializationCell->True], Cell[545107, 12277, 410, 9, 96, "Input", InitializationCell->True], Cell[545520, 12288, 1348, 28, 96, "Input", InitializationCell->True], Cell[546871, 12318, 337, 7, 69, "Input", InitializationCell->True], Cell[547211, 12327, 1481, 30, 204, "Input", InitializationCell->True], Cell[548695, 12359, 423, 9, 123, "Input", InitializationCell->True], Cell[549121, 12370, 2831, 59, 150, "Input", InitializationCell->True], Cell[551955, 12431, 617, 11, 258, "Input"], Cell[552575, 12444, 1549, 31, 177, "Input", InitializationCell->True], Cell[554127, 12477, 519, 11, 96, "Input", InitializationCell->True], Cell[554649, 12490, 522, 11, 96, "Input", InitializationCell->True], Cell[555174, 12503, 592, 12, 123, "Input", InitializationCell->True], Cell[555769, 12517, 775, 16, 96, "Input", InitializationCell->True], Cell[556547, 12535, 1324, 24, 420, "Input", InitializationCell->True], Cell[557874, 12561, 4243, 85, 528, "Input", InitializationCell->True], Cell[562120, 12648, 1334, 25, 366, "Input", InitializationCell->True], Cell[563457, 12675, 839, 16, 231, "Input", InitializationCell->True], Cell[564299, 12693, 656, 12, 258, "Input", InitializationCell->True], Cell[564958, 12707, 2485, 54, 258, "Input", InitializationCell->True], Cell[567446, 12763, 541, 11, 150, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[568024, 12779, 68, 1, 66, "Subsection"], Cell[568095, 12782, 3647, 127, 765, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[571791, 12915, 90, 1, 62, "Section"], Cell[CellGroupData[{ Cell[571906, 12920, 77, 1, 66, "Subsection"], Cell[571986, 12923, 1638, 32, 429, "Text"], Cell[573627, 12957, 1896, 40, 561, "Input"], Cell[575526, 12999, 206, 5, 69, "Text"], Cell[575735, 13006, 643, 11, 69, "Input"], Cell[576381, 13019, 265, 5, 69, "Text"], Cell[576649, 13026, 1179, 20, 231, "Input"], Cell[577831, 13048, 294, 8, 93, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[578162, 13061, 131, 6, 66, "Subsection"], Cell[578296, 13069, 421, 8, 141, "Text"], Cell[578720, 13079, 683, 15, 258, "Input"], Cell[579406, 13096, 626, 15, 165, "Text"], Cell[580035, 13113, 716, 16, 351, "Input"], Cell[580754, 13131, 1152, 31, 312, "Input"], Cell[581909, 13164, 219, 5, 93, "Text"], Cell[582131, 13171, 387, 10, 123, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[582567, 13187, 83, 1, 62, "Section"], Cell[582653, 13190, 771, 26, 141, "Text"], Cell[583427, 13218, 210, 5, 69, "Input"], Cell[583640, 13225, 367, 10, 69, "Input"], Cell[584010, 13237, 124, 3, 57, "Text"], Cell[584137, 13242, 483, 12, 123, "Input"], Cell[584623, 13256, 448, 11, 150, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[585108, 13272, 59, 1, 62, "Section"], Cell[585170, 13275, 522, 16, 99, "Text"], Cell[585695, 13293, 84, 1, 57, "Text"], Cell[585782, 13296, 366, 10, 72, "Text"], Cell[586151, 13308, 110, 3, 57, "Text"], Cell[586264, 13313, 133, 4, 69, "Text"], Cell[586400, 13319, 129, 4, 57, "Text"], Cell[586532, 13325, 264, 8, 57, "Text"], Cell[586799, 13335, 230, 7, 57, "Text"], Cell[587032, 13344, 200, 4, 69, "Text"], Cell[587235, 13350, 208, 7, 57, "Text"], Cell[587446, 13359, 239, 7, 57, "Text"], Cell[587688, 13368, 222, 7, 57, "Text"], Cell[587913, 13377, 305, 8, 57, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[588255, 13390, 57, 1, 62, "Section"], Cell[588315, 13393, 1594, 52, 307, "Text"], Cell[589912, 13447, 16348, 483, 3502, "Text"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)