Generalized Knots in Mathematica.

Representation & elementary analysis of Curves & Knots.

R.H.Beresford. 24/8/5.
 "Programming should lead to understanding, simplification & generalization."

Summary.
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).
Activate the following cell and respond "yes".

\(<< "Utilities`FilterOptions`"; << "DiscreteMath`Combinatorica`"; 
    Off[General::"spell", General::"spell1", Part::"partd", 
      Do::"iterb", Graphics::"gtype", First::"normal"]; 
    tf = TraditionalForm;\)

Evaluate the tiny cell (below, right↘) and expand the result to page width to see some
					Illustrations.

\(sK = 
      Show[curvs[perturb[simple], rad ->  .8, twist -> 2, 
          chordno -> 2], V003, DI, BF, 
        PlotLabel -> "Simple Knot
  k03001"]; sC = crossings[]; 
    Show[GraphicsArray[{{Show[curvs[4\ sq], DI, 
              PlotLabel -> "Pseudo-Circle
round a square"], 
Show[curvs[borrom], ViewPoint -> { .5, \(-2\),  .5}, 
              DI, BF, PlotLabel -> "Borromean
  Rings"], 
            Show[sK]}, {Show[curvs[ringBraid[bGord], chordno -> 1], 
              V003, DI, BF, 
              PlotLabel -> "Gordian Knot?
as a RingBraid"], 
            ShowGraph[kg08[\([6]\)], DI, 
              PlotLabel -> "Knot Graph
 kg08[[6]]"], 
            Show[sC, DI, PlotLabel -> "Knot Diagram
   k03001"]}, {Show[
              curvs[braid[b08[\([3]\)]]], V003, DI, BF, 
              PlotLabel -> " Braid
b08[[3]]"], 
            Show[curvs[weave22, rad ->  .15], V003, DI, BF, 
              PlotLabel -> "Weave"], 
            Show[curvs[hunters], V003, DI, BF, 
              PlotLabel -> "Hunter's bend"]}}]]; sC =. ; 
    sK =. ;\)

WARNING. This notebook has not been thoroughly tested, and may still contain serious errors.  knotGraph fails for links and a few knots.  Corrections will follow as they are discovered.

Revision of download from http://library.wolfram.com/infocenter/MathSource/5608/

1. Introduction.

1.1. Space-curves.

In this notebook, Space-curves are smooth lines passing through sequences of d-dimensional points (sets of d 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 segments (between points) into chords, 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 tension 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.

1.2. Knots, Braids, Knot Graphs.

"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 k0c00n (to match [1], (Subscript[c, n]) is used in [4] & [5]) indicating the n'th knot with c crossings in the simplest knot diagram (the projection onto a plane with overpasses marked).
	"Shadows" are (2D) projections of space curves onto a plane, with crossings or "nodes" identified.
	Knot diagrams are shadows with vertical information (2.5D) to indicate the over- and under-crossing lines at each node
	Braids are sets of "parallel" lines with crossings between adjacent lines; joining them end-to-end creates links that may be knots.
	Knot Graphs have edges passing through each vertex on a knot diagram.  b0c00n & kg0c00n are the braid and knot graph representations corresponding to k0c00n.

1.3. Data, Presentation.

I define generalized knots as sets of d-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.
	Section 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) kconway to create some knots as spacecurves. 
	The non-Mathematica "KnotPlot" [3] is much more sophisticated than this notebook. Interfacing routines are provided to K2K, Ochiai's encyclopaedic Mathematica 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).
	Knots_etc.nb provides a basic, accessible, Mathematica package and database for curves, tubes & knots, together with interfaces to other packages. It supplies procedures to plot generalized knots in the following formats- 
(1) As ordinates against length.
(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].
(3) As lines or tubes in 3D plots, with a choice of projection coordinates when d>3. Tube surfaces can have twisted surface meshes.
(4) As (1st-angle or 3rd-angle) projections together with a general view.
(5) As "braids", "ring-braids", and "loop-braids".
(6) As Knot Graphs.
(7) As K2K braid & knot plots.
	Knot diagrams and braids have "crossings" and are the subject of much "knot theory".  Elementary knot theory procedures are demonstrated, analysing nodeLists. (Knot polynomials can be calculated if K2K is available.)

1.4. Data Structures.

The basic data structure is a linelist containing some lines as sets of d-dimensional points. Sections 5, 6, & 7 contain many (mainly hand-made) examples. Procedures braid, loopBraid & ringbraid create a linelist from a braidlist, 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); bword is the (interchangeable) K2K equivalent.
	The curvs procedure uses piece-wise local cubic interpolation to convert a linelist into xyz, a more detailed set of coordinates that are joined by chords. This can be plotted as 2D & 3D lines or as 3D tubes, using Show[ curvs[ linelist, curvOptions], GraphicsOptions];.
	 xyz is reduced by crossings to a set of 2.5D nodes (positions with overpass information where lines cross in a 2D projection). These are listed as nodeList, a list of  the two crossing indices at each crossing. nodeList is signed to indicate the overpass and the crossing orientation and is used in all the knot & link analysis procedures. chxyz is the location of the revised chord start points; gcurv include depth and index information. Show[gcurv] plots the chords with indexed nodes.
	Knots2000(K2K) use bword and pdata, which can be created by blistToBword and nodeListToPword; their inverses create KnotsEtc data.
	 Knot graphs are sets of vertices (one per black region of the chequered diagram) joined by edges wherever two black regions meet at a node. Two plots, shown by Show[kgshow] & ShowGraph[ kgraf], are created by knotGraph[ nodeList]; the first superimposes the graph on the shadow, with edges through nodes; the second is in Combinatorica format. The database contains "rectified" graphs kg0c00n for many knots; these have the vertices on a basically square grid.
	For Mathematica 3 compatibility, Mod should be replaced by Mod1 and Rest by restv3:-

restv3[l_List] := Drop[l, {1}]

Mod1[i_, j_] := Mod[i - 1, j] + 1

1.5. Revisions.

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.

2. Tutorial.

2.1. 2D plots, piecewise cubic interpolation.

Show[curvs[2DList]] uses piecewise cubic interpolation to create and plot a curve in the form of (straight-line) chords interpolated between the points given in 2DList, closing the loop smoothly if the first and last points coincide. The slope at each point is that between the neighbours of the point. A 2D plot is drawn, with each point numbered and marked by a dot. (Higher dimensional plots are discussed below.)

(*Example 1.circling the square*)Print[{"Plot the line through the 5 points  ",sq,"\nThe line is a closed loop because the last and first point coincide."}];
Show[curvs[sq, chordno -> 3]];

The appearance of the plot can be altered by a number of options.
	A chordno 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 chordno a real number.) 
	Another option is tension; 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.
	Setting the option showlist→{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 chordno to 10 gives a smooth appearance at this scale:-

(*Example 2.  Ordinate Plot*) 
Show[
          curvs[sq, showlist -> {0}, chordno -> 10]];

Increasing tension (via options tension->1.5 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 tension=1, other regular polygons need other values. This is demonstrated for an equilateral triangle with tension->1 (the inner plot), with tension->.6,chordno->3 (the inscribed nonagon) and with tension->.6,chordno->8. This is just distinguishable from the circumcircle, which is also plotted. (The tension 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.)

equilat = {{{-(Sqrt[3])/2, -1/2}, {0, 
                1}, {(Sqrt[3])/2, -1/2}, {-(Sqrt[3])/2, -1/2}}};Show[curvs[4  equilat, chordno -> 8],curvs[4  equilat, tension ->  .6, chordno -> 3],curvs[4  equilat, tension ->  .6, 
                chordno -> 10],Graphics[Circle[{0, 0}, 4]]];

Plotting options can be used, between the closing bracket of curvs and that of Show. Adding Axes->True in Example 4 shows that a right-angle triangle {0,1},{1,0},{-1,0}, with tension->.6, gives a pseudo-ellipse through the three specified points.

(*Example 4.  Right - angle Triangle gives a pseudo - 
            ellipse with tension ->  .6*)Show[
          curvs[tri = {{{0, 1}, {1, 0}, {-1, 0}, {0, 1}}}, 
            tension ->  .6], Axes -> True];

2.2. Plotting higher-dimensional spacecurves.

Space-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 showlist->{1,2,3} 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 .

(*Example 5.  wxy projection of hypercube traversal*) Show[curvs[ph = perturb[hypercube4,  .1], chordno -> 6. , 
          showlist -> {1, 2, 3}, rad -> 0], 
        Axes -> False];

Show[
        curvs[ph, showlist -> {1, 2, 4}, rad ->  .05, 
          chordno -> 4], Boxed -> False];

2.3. 3D plots as lines or tubes.

Curves 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 twist->3  which rotates the tube longitudinal mesh 3 times. The viewpoint can be changed from the standard one (used in Ex.6.) via a Graphics3D ViewPoint option such as ViewPoint->{0,0,9}; note the capital P and the position outside the curvs[] instruction; it can be abbreviated to V009, one of several pre-programmed abbreviations.
	 3D objects can also be shown as "engineering drawings" together with the standard view, by firstAngle[] & thirdAngle[]. (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:-

Show[
        curvs[simple, rad -> 0], AF];

    Show[curvs[simple, twist -> 3], V009, BF];

    Show[thirdAngle[simple]];

Multiple lines are handled by curvs[{{line1},{line2}...}] 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:-

Show[
        GraphicsArray[{{Show[curvs[borrom], DisplayFunction -> Identity, BF, 
                V291], 
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]}}]];

The format for GraphicsArray requires DisplayFunction->Identity (abbreviated to DI) in every Show instruction, because DisplayFunction is reset by curvs. BF is an abbreviation for Boxed->False. V291 sets a suitable viewpoint.

"Local options" can be set by including them ahead of the line to which they apply. The data for hitch1 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:-

hitch1

    Show[thirdAngle[hitch1]];

2.4. Braids & weaves.

Knots 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.

(*Example 10.  4 - 
        thread Braid representing two closed loops*) 
Show[curvs[braid4b], V009, BF];

Example 11 corresponds to a 4-braid forming a single strand (Conway's knot). It is described by a braidlist. This Mathematica-compatible form is obtained from the "braid word" that descrbes this knot, \(TraditionalForm\`\(σ\_2\%3\) \(σ\_1\) \(σ\_3\%\(-1\)\) \(σ\_2\%\(-2\)\) \(σ\_1\) \(σ\_2\%\(-1\)\) \(σ\_1\) σ\_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 loopBraid, my name for the standard closure, and as a ringBraid.  A linelist is created by appropriate procedures from the braidlist, allowing standard knot analysis procedures of section 2.7 to be applied to braids.

Show[
      curvs[braid[b11con]], V003, BF]; 
    Show[curvs[loopBraid[b11con]], V003, BF]; 
    Show[curvs[ringBraid[b11con]], V003, BF];

Section 6 contains a normal braidlist 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.

Show[
        curvs[braid[b08[[3]]], rad ->  .2], V003, 
        BF];

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:-

Show[
        GraphicsArray[{{Show[curvs[weave22, rad ->  .2], 
                ViewPoint -> {0, 0, 9}, DI, BF], 
              Show[curvs[weave77a], ViewPoint -> {0, 1, 3}, DI, BF], 
              Show[curvs[weave436], ViewPoint -> {0, 1, 3}, DI, 
                BF]}}]];

2.5. Bends.

In 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".
	Example 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.

Show[
        GraphicsArray[{{Show[curvs[reef3d2], V009, DI, BF, 
                PlotLabel -> "Reef A1402"], 
              Show[curvs[granny], V009, DI, BF, 
                PlotLabel -> "Granny A1405"]}, {Show[curvs[thiefs], V009, 
                DI, BF, PlotLabel -> "Thief A1207"], 
              Show[curvs[whatnot], V009, DI, BF, 
                PlotLabel -> "Whatnot A1406"]}, {Show[curvs[sheetbend], 
                V009, DI, BF, PlotLabel -> "Sheetbend A1431"], 
              Show[curvs[tuckedSheetBend], V009, DI, BF, 
                PlotLabel -> "TuckedSheetbend"]}, {Show[curvs[ringKnot1], 
                V009, DI, BF, PlotLabel -> "Ring or Gut A1412"], 
              Show[curvs[binderKnot], V009, DI, BF, 
                PlotLabel -> "Binder~A1412"]}}]];

Ashley 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.

Show[
        thirdAngle[hunters]];

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):-

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 -> 0] /. pts -> {}, 
            Graphics[{Text["A", {0, 2.3}], Text["B", {0, - .3}], 
                Text["C", {0, 1}], Text["L", {-1, 1.5}], 
                Text["R", {1, 1.5}]}]}, DI, 
          Axes -> False];
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 -> 0] /. 
              pts -> {}, 
            Graphics[{Text["A", {-1, 1.3}], Text["U", {1, 1.3}], 
                Text["L", {-1,  .4}], Text["R", {1,  .6}], 
                Text["D", {-1, - .4}], 
                Text["B", {1, - .4}]}]}, DI, 
          Axes -> False];
Show[GraphicsArray[{{t1DI, t2DI}}]];

Many 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.  
	"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.

Show[
        GraphicsArray[{{Show[curvs[waterKnot], V009, DI, BF, 
                PlotLabel -> "WaterKnot C"], 
              Show[curvs[waterKnotx], V009, DI, BF, 
                PlotLabel -> "WaterKnotx -c"]}, {Show[
                curvs[zeppelinKnot /. a -> 0, rad ->  .4], V009, DI, BF, 
                PlotLabel -> "Zeppelin Knot RaL"], 
              Show[curvs[rL], V009, DI, BF, PlotLabel -> "rL"]}, {Show[
                curvs[gord, rad ->  .3], V009, DI, BF, 
                PlotLabel -> "Gordian? Knot LaRLaR"], 
              Show[curvs[CaR], V009, DI, BF, PlotLabel -> "CaR"]}, {Show[
                curvs[MW2, rad ->  .3], V009, DI, BF, 
                PlotLabel -> "CaC 2strand\nMathew Walker"], 
              Show[curvs[lBr], V009, DI, BF, 
                PlotLabel -> "lBr A1425"]}}]];

The 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.

To 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?)
	A 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.
	Ashley 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.

2.6. Hitches and Binding knots.

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.

Show[
        GraphicsArray[{{Show[curvs[hitch2], DI, BF, 
                PlotLabel -> "Clovehitch"], 
              Show[curvs[constrictor], ViewPoint -> {0, 4, -2}, DI, 
                BF, PlotLabel -> "Constrictor"]}, {Show[
                curvs[singlepass], ViewPoint -> {0, -2, 4}, DI, BF, 
                PlotLabel -> "singlepass Tow-hitch"], 
              Show[curvs[boa], ViewPoint -> {0, 2, 4}, DI, BF, 
                PlotLabel -> "Boa"]}}]];

Show[
        GraphicsArray[{{Show[curvs[Magnus, rad ->  .25], 
                ViewPoint -> {-5, -5, 3}, DI, BF, 
                PlotLabel -> "A1736 Magnus hitch"], 
              Show[curvs[Prusik], ViewPoint -> {-5, -5, 3}, DI, 
                BF, PlotLabel -> "A481 Prusik Knot"]}}]];

2.7. Links.

Links are multiple loops. The Borromean links were shown in Example 8.
kn[n] creates four sorts of space curve. If n is odd, the circular knot of n crossings is produced. If n is even, two linked loops are produced. These have 2n crossings if they have the same centre. One loop may be given an x displacement, giving either two (Hopf links) or no (separated links) crossings:-

kn2 = Show[curvs[kn[2], rad ->  .4], DI, BF, V009]; 
    kn3 = Show[curvs[kn[3], rad ->  .4], DI, BF, V009]; 
    kn4 = Show[curvs[kn[4], rad ->  .4], DI, BF, V009]; 
    knk = Show[curvs[kn[2, 1, - .1, 1], rad ->  .2], DI, BF, 
        V009];
Show[GraphicsArray[{{kn2, kn3}, {kn4, knk}}]];

2.8. Crossings, Knot Diagrams, Knot Analysis.

Knots and links can be analysed after they have been created by curvs loopbraid, or ringbraid. These create lists xyz of chord-end coordinates, which can be analysed (slowly if chordno is >2) for crossing points of the line(s) in the knot shadow. This is done by crossings[], 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 perturb[list_, f_:.001], which randomly adds or subtracts to each ordinate a displacement of up to f of the knot maximum dimension.
	crosscurv[List_] provides a short-cut that does the same analysis, calling curvs & crossings with the appropriate options (including perturbation), plotting the labelled diagram, and finally calling linkMatrix and dowth. These are printed if the print parameter pr is 1 (linkMatrix), 2 (writhe), or 3 (both). The plot is suppressed if pr<0.
	The results are stored in nodeList (a global variable). This can be converted to the Dowker-Thistlethwaite name by dowth[], 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.
	writhe[] 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 linkMatrix 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 writhe for each link.
	 bridgeCount[] counts the number of bridges in a diagram (its minimum, the bridgenumber, is a knot invariant that is difficult to find).

\(\(\( (*\(Example\ 21. \ A\ 7  
              crossing\ knot\ analysed\ for\ crossings\  &\)\ Dowker - 
        Thistlethwaite\ name, \ 
      writhe, \ \(\(&\)\(\ \)\(drawn\)\(\ \)\(by\)\(\ \)\(K2K\)\)*) \)\(
\)\(Show[
      K72 = curvs[perturb[k07002,  .0001], rad ->  .5, 
          chordno -> 2], BF, V009]; 
    Show[crossings[]]; {"nodeList = ", 
      nodeList, "
Dowker-Thistlethwaite name = ", 
DT = dowth[nodeList], "
Writhe =", 
writhe[]}

    ShowKnotfromPdata[KnotbyDT[DT]]; DT =. \)\)\)

(*Example 22.  A 7  
        crossing unknot analysed by crosscurv.*) 
Show[
      u7 = curvs[perturb[unknot7,  .001], rad ->  .2, 
          chordno -> 2], BF, V009]; pr = 3; crosscurv[unknot7]; 
    pr = 0;

(*Example 23. twolink analysed for crossings, Dowker - Thistlethwaite name.*)
Show[
        curvs[perturb[twolink,  .01], rad ->  .1, chordno ->  .2], 
        V009, BF]; 
      Show[crossings[]]; {"nodeList=", 
        nodeList, 
"Dowker-Thistlethwaite name=", 
        dowth[]}

(*Example 24. links888 analysed for crossings, Dowker - Thistlethwaite name, writhe.*)pr = 3; 
      Show[curvs[perturb[links888,  .001], rad ->  .1, 
          chordno -> 3], V009]; crosscurv[links888]; 
      pr = 0; {"Dowth ", 
        dowth[], "\nWrithe", 
writhe[]}

2.9. Knot Diagram Simplification.

The 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.
	Two "unknots" are reduced to the simple unknot in the next examples. The sequence of moves to use is a matter of trial and error.
	The K2K ReductionKnotLink.exe procedure simplifies knots in pldata format. (It presumably has some limitations, but Example 41. correctly reduces a 34-crossing knot, obtained from a braid, to a 16 crossing knot.)

Show[
      curvs[perturb[unknot3,  .0001], chordno -> 2], V009, BF]; 
    Show[crossings[]]; {"nodeList=", 
      nodeList, "\nR1[R2[]] reduces this to the unknot ", 
      R1[R2[]]}

crosscurv[
      unknot7]; {"nodeList=", 
      nodeList, "\nand R1[R2[R2[]]] gives the unknot ", 
      R1[R2[R2[]]]}

2.10. 4D curves

Any 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:-

t234 = Show[curvs[simple4, showlist -> {2, 4, 3}], DI, BF, V009]; 
    k234 = Show[curvs[simple4, showlist -> {2, 3, 4, 1}, rad -> 0], 
        DI, AF, PlotLabel -> "k234"]; 
    k342 = Show[curvs[simple4, showlist -> {3, 4, 2, 1}, rad -> 0], 
        DI, AF, PlotLabel -> "k342"]; 
    k423 = Show[curvs[simple4, showlist -> {4, 2, 3, 1}, rad -> 0], 
        DI, AF, PlotLabel -> "k423"];

\(t134 = Show[curvs[simple4, showlist -> {3, 1, 4}], DI, BF, V009]; 
    k134 = Show[curvs[simple4, showlist -> {1, 3, 4, 2}, rad -> 0], 
        DI, AF, PlotLabel -> "k134"]; 
    k341 = Show[curvs[simple4, showlist -> {3, 4, 1, 2}, rad -> 0], 
        DI, AF, PlotLabel -> "k341"]; 
    k413 = Show[curvs[simple4, showlist -> {4, 1, 3, 2}, rad -> 0], 
        DI, AF, PlotLabel -> "k413"];

\)
t124 = Show[curvs[simple4, showlist -> {1, 2, 4}], DI, BF, V009]; 
    k124 = Show[
        curvs[simple4, showlist -> {1, 2, 4, 3}, rad -> 0] /. 
          pts -> {}, DI, AF, 
        PlotLabel -> "k124"];
k241 = 
      Show[curvs[simple4, showlist -> {2, 4, 1, 3}, rad -> 0] /. 
          pts -> {}, DI, AF, PlotLabel -> "k241"]; 
    k412 = Show[
        curvs[simple4, showlist -> {4, 1, 2, 3}, rad -> 0] /. 
          pts -> {}, DI, AF, 
        PlotLabel -> "k412"];

t123 = Show[curvs[simple4, showlist -> {1, 2, 3}], DI, BF, V009]; 
    k123 = Show[
        curvs[simple4, showlist -> {1, 2, 3, 4}, rad -> 0] /. 
          pts -> {}, DI, AF, PlotLabel -> "k123"]; 
    k231 = Show[
        curvs[simple4, showlist -> {2, 3, 1, 4}, rad -> 0] /. 
          pts -> {}, DI, AF, PlotLabel -> "k231"]; 
    k312 = Show[
        curvs[simple4, showlist -> {3, 1, 2, 4}, rad -> 0] /. 
          pts -> {}, DI, AF, 
        PlotLabel -> "k312"];
Show[
        GraphicsArray[{{t234, k234, k342, k423}, {t134, k134, k341, 
              k413}, {t124, k124, k241, k412}, {t123, k123, k231, 
              k312}}]];

The output with rad→0 allows curves to be modified, as each point is numbered unless "/.pts->{}," is included. Piece-wise cubic interpolation ensures that changes are local. I attempted to make simple4 into a knot in all four subspaces, but failed with t134.

2.11. Curve and Knot Rotations.

The matrices rx3, rx4, ry3, ry4, rz3, rz4, etc. rotate single lines of the indicated dimensionality by the specified anticlockwise angle. rxyz3 & rxyz4 rotate lineLists; different lines are extracted from the list, rotated, and then put back into a list:-

(*Example 28.  Rotating the simple knot*) 
Show[curvs[simple], V090, BF]; 
    Show[curvs[{simple[[1]] . ryz[π/4,  .2]}], V090, BF]; 
    Show[curvs[rxyz3[borrom, π/3, 1,  .1]], V090, BF];

(*Example 29.  Rotating both parts of the weavers knot*) Show[curvs[{weavers[[1]] . ryz[π/3,  .2], 
            weavers[[2]] . ryz[π/3,  .2]}, rad ->  .1], V009, 
        BF];

2.12. Gallery of Knot Graphs.

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.
	To create a graph from a lineList, a knot diagram must first be created by crosscurv (NOT crossings, because this does not perturb the points, and so may give ill-conditioned diagrams). kgraf  (a graph in the Combinatorica format) is created. It can be shown by ShowGraph[knotGraph[par]];. The graph can also be shown superimposed on the knot shadow, with edges distorted to pass through the corresponding vertices, by Show[kgshow];. The parameter par scales the vertices to improve kgshow 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 par in most of the lineLists in this notebook.
	Vertices 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 Δ, or vice-versa. This can be used to minimize the number of vertices.
	The procedure relies on there being only one line in the diagram, so it fails for links.

crosscurv[k10129];
knotGraph[1];Show[kgshow, AF];Print["This has given the wrong result, so negate par.\nNote that knot graphs have multiple edges wherever white regions have only two nodes."];
ShowGraph[knotGraph[-1.5]]; Show[kgshow, AF]; 
    Print["The rectified graph is of the inverted knot"];  
    ShowGraph[kg10129];

"Tidy" knotgraphs kg0c00n and kgc[[n]] are supplied for all simple knots with up to 8 vertices, for a few larger knots, and for a few composite knots bcn1 n2 (these have single vertices between the components n1 & n2). 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.
	Unresolved problem - vertices do not always show up in the gallery if edges are collinear, so some graphs have had to be distorted.

Show[GraphicsArray[{{ShowGraph[kg31, DI, PlotLabel -> "K 3"],ShowGraph[kg41, DI, PlotLabel -> "K 4"],ShowGraph[kg05001,DI,PlotLabel->"K 5,1"],ShowGraph[kg05002,DI,PlotLabel->"K 5,2"],ShowGraph[kg06001,DI,PlotLabel->"K 6,1"],ShowGraph[kg06002,DI,PlotLabel->"K 6,2"]},{ShowGraph[kg06003,DI,PlotLabel->"K 6,3"],ShowGraph[kg06c33,DI,PlotLabel->"K 3#3"],ShowGraph[kg06n33,DI,PlotLabel->"K 3#3a"],ShowGraph[kg07c34,DI,PlotLabel->"K 3#4"],ShowGraph[kg07[[1]],DI,PlotLabel->"K 7,1"],ShowGraph[kg07[[2]],DI,PlotLabel->"K 7,2"]},{ShowGraph[kg07[[3]],DI,PlotLabel->"K 7,3"],ShowGraph[kg07[[4]],DI,PlotLabel->"K 7,4"],ShowGraph[kg07[[5]],DI,PlotLabel->"K 7,5"],ShowGraph[kg07[[6]],DI,PlotLabel->"K 7,6"],ShowGraph[kg07[[7]],DI,PlotLabel->"K 7,7"],ShowGraph[kg08[[1]],DI,PlotLabel->"K 8,1"]},{ShowGraph[kg08[[2]],DI,PlotLabel->"K 8,2"],ShowGraph[kg08[[3]],DI,PlotLabel->"K 8,3"],ShowGraph[kg08[[4]],DI,PlotLabel->"K 8,4"],ShowGraph[kg08[[5]],DI,PlotLabel->"K 8,5"],ShowGraph[kg08[[6]],DI,PlotLabel->"K 8,6"],ShowGraph[kg08[[7]],DI,PlotLabel->"K 8,7"]},{ShowGraph[kg08[[8]],DI,PlotLabel->"K 8,8"],ShowGraph[kg08[[9]],DI,PlotLabel->"K 8,9"],ShowGraph[kg08[[10]],DI,PlotLabel->"K 8,10"],ShowGraph[kg08[[11]],DI,PlotLabel->"K 8,11"],ShowGraph[kg08[[12]],DI,PlotLabel->"K 8,12"],ShowGraph[kg08[[13]],DI,PlotLabel->"K 8,13"]},{ShowGraph[kg08[[14]],DI,PlotLabel->"K 8,14"],ShowGraph[kg08[[15]],DI,PlotLabel->"K 8,15"],ShowGraph[kg08[[16]],DI,PlotLabel->"K 8,16"],ShowGraph[kg08[[17]],DI,PlotLabel->"K 8,17"],ShowGraph[kg08[[18]],DI,PlotLabel->"K 8,18"],ShowGraph[kg08[[19]],DI,PlotLabel->"K 8,19"]},{ShowGraph[kg08[[20]],DI,PlotLabel->"K 8,20"],ShowGraph[kg08[[21]],DI,PlotLabel->"K 8,21"],ShowGraph[kg08[[22]],DI,PlotLabel->"K 8,4#4"],ShowGraph[kg08[[23]],DI,PlotLabel->"K 8,4#4a"],ShowGraph[kg09023,DI,PlotLabel->"K 9,23"],ShowGraph[kg1000a,DI,PlotLabel->"K1000a"]},{ShowGraph[kg10104,DI,PlotLabel->"K10104"],ShowGraph[kg10105,DI,PlotLabel->"K10105"],ShowGraph[kg10129,DI,PlotLabel->"K10129"],ShowGraph[kg10161,DI,PlotLabel->"K10161"],ShowGraph[kg11255,DI,PlotLabel->"K11255"],ShowGraph[kg11257,DI,PlotLabel->"K11257"]}}]];

2.13. Conway Notation (rudimentary).

Conway [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.
	Tangles 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.
	Continued-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.
	He 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.
	He 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).
	ConwayUnpack[string,True/False] unpacks a basic string, giving the continued fraction if True is specified.

ConwayUnpack["23-2", 
        True];

    ConwayUnpack["2111", True];

    ConwayUnpack["42,3,2-", True];

    ConwayUnpack["41,22,21", True];

Only the basic Conway notation, a string of up to 3 integers, is implemented as kConway.

pr = 0;res=kConway["32"];res1=kConway["222"];Show[
        GraphicsArray[{{Show[
                curvs[res, rad -> 0, chordno -> 4, 
                    tension -> 2] /. pts -> {}, DI, AF], 
              Show[curvs[res, rad ->  .3, chordno -> 4, 
                  tension -> 2], V003, DI], 
              Show[curvs[res1, rad -> 0, chordno -> 4, 
                    tension -> 2] /. pts -> {}, DI, AF]}}]];

pr = 0;kn2=Show[curvs[kConway["2"],rad ->  .2,tension -> 2],DI,V009];kn3=Show[curvs[kConway["3"],rad ->  .2,tension -> 2],DI,V009];kn4=Show[curvs[kConway["34"],rad ->  .4,tension -> 2],DI,V009];knk=Show[curvs[kConway["332"],rad ->  .4,tension -> 2],DI,V009];
Show[
        GraphicsArray[{{kn2, kn3}, {kn4, knk}}]];

kConway should create Pretzels, but this has not been implemented; kpretzel is demonstrated:-

res = kpretzel[{3, 3, 2}]; 
    Show[GraphicsArray[{{Show[
              curvs[res, rad -> 0, chordno -> 2] /. pts -> {}, 
              AF, DI], 
            Show[curvs[res, rad ->  .3, chordno -> 2], V003, DI, 
              BF]}}]];

2.14. Knots via K2K.

The routines in Section 3.9. link K2K and KnotsEtc. They are demonstrated in the following examples.

2.14.1 Graphical input of knots via K2K.

Use name= GetPdatabyTracking[] to input or revise a knot (or link) diagram in a mouse-tracking window. The resulting pdata will be stored as name so that it can be investigated by other functions. 

Instructions.
	Left-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 L  astPLdata . pl (which can be inspected by !!LastPLdata.pl). Use the bottom "Quit" instruction (or use ESC; DO NOT use the red X).

Use Ex.36 to create and store a trefoil knot:-

k36 = 
      GetPdatabyTracking[]

    ShowKnotfromPdata[k36]

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):-

\(\(\( (*Example\ 37\ *) \)\(k37 = GetPdatabyTracking[]

    ShowKnotfromPdata[k37]\)\)\)

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.

ShowKnotbyOpengl[{{7, 6}, {-15, -25, 7, 13, -19, -21, 
            5, -2, 23, -10, -8, 17, -14}}];

?ShowKnotbyOpengl

2.14.2 K2K Knots from braidlist.

Routines interconvert between braidlist (KnotsEtc) and bword (K2K); graphs shown as ringBraids can be converted to K2K-style knot diagrams as follows:-

Show[
        curvs[ringBraid[{3, 3, -1, -2, 3, 3, 1, -2, 
              3, -1, -1}]], V009];

    bl = blistToBword[{3, 3, -1, -2, 3, 3, 1, -2, 
          3, -1, -1}]

    bwdtonumwd[bl]

    ShowKnotfromPdata[k38 = KnotFromBraid[bl]]

See Example 41, which finds braids from the databank.

2.14.3 K2K Knots and lineList via crosscurv.

KnotsEtc data can be converted to K2K format via crosscurv & nodeListToPdata. and then shown via ShowKnotfromPdata. K2KShow combines these in one instruction.

pr = -1  ; 
    crosscurv[k08005]; n08005 = nodeList

    p08005 = nodeListToPdata[n08005]

    ShowKnotfromPdata[p08005]

    K2KShow[k09023]

    p08005 =. ; n08005 =. ;

2.14.5 K2K Knots from Thistlethwaite Data.

The plist can be found for  201691 non-alternate knots with 10 to 15 crossings:-

p15999 = 
      plistFromK2K[15, 999]

    ShowKnotfromPdata[p15999];

The ShowKnotfromPdata procedure should have been modified to create a lineList "ll" if the parameter p is 3. This creates a lineList ll for the knot so that KnotsEtc routines can be applied:-

(*Example 41.  lineList from K2K knot *) ShowKnotfromPdata[p15999, 3];

    Show[crossings[ll]]; ShowGraph[knotGraph[-3]];

    ll =. ; p15999 =. ;

bword 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; ReductionKnotLink finds a simple version. The example has 34 crossings but reduces to 16.

(*Example 42.  The 999  th 16-crossing non-alternate knot via bword*)
bw16999 = blist[16, 999]

      b16999 = bwdtonumwd[bw16999]

      Length[b16999]

      Show[curvs[ringBraid[b16999], chordno -> 2], V009, 
          BF];

      ShowKnotfromPdata[p16999 = KnotFromBraid[bw16999]]

      p16999

      ShowKnotfromPdata[
        r16999 = ReductionKnotLink[p16999]]

      Length[r16999[[2]]]

      bw16999 =. ; b16999 =. ; p16999 =. ; r16999 =. ;

2.15. Knot Polynomials via K2K.

Bracket 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 (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.

x =. ; t =. ; k36 = {{3}, {-5, -1, -3}};
KauffmanPolynomial[k36]
SkeinPolynomial[0, k36]
SkeinPolynomial[1, k36]
SkeinPolynomial[-1, k36]
SkeinPolynomial[-2, k36]
k36 =. ;

blist data is available for simple knots with up to 9 crossings as genKnot[[c,n,6]]., and for larger knots from the K2K files. (It can also be found via blist[cr,index].) Create a knot and find the polynomials:-

p40 = KnotFromBraid[blistTobword[genKnot[[9, 13, 6]]]]
ShowKnotfromPdata[p40]
KauffmanPolynomial[p40]
SkeinPolynomial[0, p40]
SkeinPolynomial[1, p40]
SkeinPolynomial[-1, p40]
SkeinPolynomial[-2, p40]
p40 =.

3. Curve, Knot, Braid Input and Display Routines. K2K links.

3.1. Plotting. curvs, perturb , thirdAngle, Vxyz etc.

Procedures curvs, perturb , thirdAngle, firstAngle.

Clear[curvs, chordno, chono, d, p1, perimno, rad, sh, tension, twist, 
      curvsFraming, curvsPrelude, showlist, perturb, thirdAngle, firstAngle]; 
    pr = 0;

Options[curvs]={rad -> 1/4, chordno -> 3. , perimno -> 6, 
          showlist -> {1, 2, 3}, tension -> 1, twist -> 0, 
          PlotRange -> All, curvsFraming -> Normal, 
          AspectRatio -> Automatic, Axes -> False, 
          PlotStyle -> {Hue[ .7], Hue[ .3]}, 
          curvsPrelude -> {}};  
curvs[lines_?ListQ, opts___Rule : {}] := 
Module[{c,ch,d,dim = Length[lines[[-1, -1]]],l,localopts = {opts},ls,lt,p1,r,sh=showlist/.{opts}/.Options[curvs]},
If[Length[sh] > dim, sh = Take[sh, dim]];
If[
                  Max[sh] > dim || Min[sh] < 0 || 
                    Length[Union[sh]] ≠ Length[sh], 
                  Print[{"Error in showlist ", sh}]; Abort[]];ls = Length[sh];
  xyz  =  {};gcurv = {};pts  =  {};
$DisplayFunction  =  Identity; 
Do[l=lines[[i]];(*For each element of lines*)
Switch[Head[l],
Rule,  PrependTo[
                          localopts, l],
List,If[! MatrixQ[l], 
                              Print[{"Error in input ", 
                                  lines  }]; 
                              Abort[]];
(*New curve .  Select showlist dimensions? Apply options .  Call spacecurve*)
If[ls ≠ 1&&sh≠Range[dim],lt = 
                                Transpose[l]; 
l = {}; 
                              Do[PrependTo[l, 
                                  lt[[Abs[sh[[j]]]]]], {j, ls}]; 
                              l = Transpose[l]];
  
If[pr > 8, 
                              Print[{"Options", 
                                  Flatten[{localopts, Options[curvs]}]}]];
{r, ch, pe, te, 
                              tw} = {rad, chordno, perimno, tension, twist} /. 
                              Flatten[{localopts, Options[curvs]}];
If[ls < 3, r = 0];  
If[te < 1/4, te = 1/4];  
If[pr > 8, 
                              Print[{"Call spacecurve", l, r, ch, sh, pe, 
                                  te, tw}]];
spacecurve[l, r, ch, sh, pe, te, tw];localopts = {opts},
_,Print[{"Error in ", lines}]; Abort[]],
{i, Length[lines]}];(*Save all curves in gcurv and allow plotting*)
 $DisplayFunction  =  Display[$Display,  #1]  & ;{gcurv, pts} ];

perturb[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 ≠ 1 && i ≠ Length[l[[h]]], 
                    dm (2  Random[] - 1), 0], {j, jmax}], {i, 
                Length[l[[h]]]}], 
{h, Length[l]}]; 
          res];

thirdAngle[k_, opts___Rule : {}]:=Module[{k22 = {{{}, {}}, {{}, {}}}, k1 = curvs[k, opts]},k22[[1, 1]]=Show[k1,ViewPoint -> {0, -999, 0},DI];k22[[1, 2]]=Show[k1,ViewPoint -> {-999, 0, 0},DI];k22[[2, 1]]=Show[k1,ViewPoint -> {0, 0, 999},DI];k22[[2, 2]]=Show[k1,DI];$DisplayFunction  =  Display[$Display,  #1]  & ;GraphicsArray[k22]];

firstAngle[k_, opts___Rule : {}]:=Module[{k22 = {{{}, {}}, {{}, {}}}, k1 = curvs[k, opts]},k22[[1, 1]]=Show[k1,ViewPoint -> {0, 999, 0},DI];k22[[1, 2]]=Show[k1,ViewPoint -> {999, 0, 0},DI];k22[[2, 1]]=Show[k1,ViewPoint -> {0, 0, 999},DI];k22[[2, 2]]=Show[k1,DI];$DisplayFunction  =  Display[$Display,  #1]  & ;GraphicsArray[k22]];

Abbreviations Xxyz, AA,AF,DI,BF,LF.

V900=ViewPoint -> {9, 0, 0};V090=ViewPoint -> {0, 9, 0};V291=ViewPoint -> {2, 9, 1};V009=ViewPoint -> {0, 0, 9};V003=ViewPoint -> {0, 0, 3};AF=Axes -> False;AA=AspectRatio -> Automatic;DI=DisplayFunction -> Identity;BF=Boxed -> False;LF=Lighting -> False;

3.2. spaceCurve.

Procedure spaceCurve.

(* 20/3/5 Calculates cubic, interpolates, and calls either curvshow or tubeshow .  t = 
              j/d .  twist*)
spacecurve[f_, r_, chono_, sh_, p1_, 
          te_, twi_]:=Module[{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}, smax = 0. ;If[pr > 8, 
                  Print[{"Start spacecurve with f=", f}]];
 (*For each line,  
                  add/remove end points for threads/loops.*) 
f0=If[(f1 = f0[[1]]) == (f2 = 
                            f0[[-1]]),
dr--; Most[f0]  ,
dl++; 
                      Insert[Insert[f0, 2  f1 - f0[[2]], 1], 
                        2  f2 - f0[[-2]], -1]  ] ;If[pr > 8, 
                  Print[{"spacecurve f0,dl,dr,te", f0, dl, dr, te}]];  
 fl = RotateLeft[f0];s =  .8 (fl - RotateRight[f0])/te;
uo = fl - f0;s2 = RotateLeft[s];a = 3 uo - 2  s - s2;b = -2 uo + s + s2;
  
seglen = 
                N[Plus @@ 
                    Transpose [(Sqrt[4 (a^2)/3 + 3 a b + 9 (b^2)/5 + 2 (a + b) s + (s^2)])]];  
If[tw ≠ 0 && tw ∈ Rationals,curvlen = Plus @@ seglen;  tw = 
                      2  π tw/curvlen];
  
dt = IntegerPart[seglen chono + 1];smax = Max[smax, seglen];uu = 1;
If[pr > 8, 
                  Print[{"seglen,dt,curvlen", seglen, dt, curvlen}]];
Do[d = dt[[i]];If[IntegerQ[chono], d = chono];If[d == 0,  ,
ds = seglen[[i]]/d;ai = a0[[-1]];AppendTo[u, uu];
       Do[t = j/d;AppendTo[cof, 
                                  Chop[N[(f0[[
                                        i]] + 
                                        t (s[[i]] + 
                                        t (a[[i]] + 
                                        t*b[[i]])))]]];
If[r ≠ 0,   AppendTo[slopes, 
                                      Chop[N[(s[[i]] + 
                                        t (2  a[[i]] + 
                                        3  t*b[[i]])) ds]]]];
  If[tw ≠ 0,   AppendTo[a0, 
                                        Mod[a0[[-1]] + tw ds, 
                                        2  π]];If[pr > 8, 
                                        Print[{"a0", a0, ai, tw, ds}]];];
uu++,
{j, 1, d}]],
{i, dl, dr}];
PrependTo[cof, cof[[-1]]];If[r ≠ 0, 
                PrependTo[slopes, slopes[[-1]]]];
If[tw == 0, 
                a0 = Table[0, {Length[cof]}]];
If[pr > 8, 
                  Print[{"spacecurve dr dl length f0", dr, dl, dr - dl, 
                      Length[f0], "a0", a0}]];
If[dl == 2, cof = Rest[cof]];
xyz = AppendTo[xyz, cof](* for crossings & depthshow *);
If[r > 0,If[pr > 8, 
                        Print[{"Calling tubeshow", cof, "slopes", 
                            slopes, dl, r, p1, a0}]];tubeshow[cof, slopes, dl, r, p1, a0],
       If[
                      Length[sh] > 
                        2, uo = 
                          Sign[Transpose[
                                f0][[sh[[3]]]]];
, uo = Table[0, {i, Length[f0]}]];
If[pr > 8, 
                        Print[{"Calling  curvshow f0,cof", f0, 
                            Short[cof], sh, "=sh, uo,u=", uo, u}]];
 curvshow[f0, cof, sh, uo, u]
;]]

3.3. tubeshow,  makePolygons.

3.3.1. Procedures tubeshow,  makePolygons.

Clear[tubeshow, v, w];

MakePolygons[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]]

Normalize[v_]:=v/Sqrt[v . v];Options[tubeshow]={tubeFraming -> Normal, tubeshowPrelude -> {}};tubeshow[cof_, sl_, dl_, r_, p1_, 
            a0_]:=Module[{npoints, gvec = N[{1.0, 1.0, 1.0}/(Sqrt[3])], framing, 
                prelude,   tmesh},
npoints=Normalize/@sl;vpoints=Normalize/@(gvec -= gvec . #1 #1 &) /@ npoints;xpoints=Normalize/@(Cross @@ #1 &) /@ 
                      Transpose[{npoints, vpoints}];
scpoints=  
Table[
                    N[{Cos[t + a0[[i]]], Sin[t + a0[[i]]]} r], {i, 
                      1, Length[cof]}, {t, 0, 2 π, 2 π/p1}];tmesh = 
                  Table[cof[[i]] + 
                      scpoints[[i, 
                            j]] . {vpoints[[i]], 
                          xpoints[[i]]}, {j, 1, p1 + 1}, {i, dl, Length[cof]}];AppendTo[gcurv,Show[Graphics3D[MakePolygons[tmesh],FilterOptions[Graphics3D, localopts, 
                              opts]]]]];

3.4. curvshow, pointer, depthshow.

3.4.1. Procedures curvshow, pointer.

Clear[pointer, curvshow];

pointer[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]

curvshow[h_, cof_, sh_, uo_, u_]:=  
Module[{c = Transpose[cof], cof2, cof3 = {}, ls = Length[sh], 
              o},cof2 = Transpose[Take[c, 2]];siz = Flatten[cof2];siz = Max[siz] - Min[siz];If[ls > 2, cof3 = Take[c, {3}][[1]]];If[pr > 8, 
                  Print[{"curvshow cof2,3", Short[cof2], 
                      Short[cof3], "ls", ls, " sh =", sh}]];
  
	Which[sh == {0},  
Do[
                    AppendTo[gcurv, 
                      ListPlot[c[[ii]], PlotJoined -> True, 
                        PlotStyle -> Hue[ .29  ii]]], 
{ii, 
                      Length[c]}],
ls == 1,  
AppendTo[gcurv, 
                    ListPlot[c[[sh[[1]]]], PlotJoined -> True]],
	ls > 2,  AppendTo[pts,Show[Graphics[pointer[cof2, 
                                uo, u],AF,AA]]];  AppendTo[gcurv,Show[Graphics [
                            ListPlot [cof2, PlotJoined -> True, 
                              PlotStyle -> {Thickness[ .005], 
                                  Hue[Mod[Length[gcurv], 6]/6]}], AF, AA]]],
ls == 2,  AppendTo[pts,Show[Graphics[pointer[cof2, 
                                uo, u],AF,AA]]];
 AppendTo[gcurv,Show[Graphics [ListPlot [cof2,PlotJoined -> True,PlotStyle -> {Thickness[ .005], 
                                    Hue[Mod[Length[gcurv], 6]/6]},FilterOptions[Graphics2D, 
                                    localopts, opts],AF,AA]]]],
_,Print [{"weird Length & rad combination ", 
                        ls, rad} ]];
];

3.4.2. Procedures lineEnds, depthshow.

Clear[depthshow, lineEnds]; xyz =. ;

lineEnds[lin_]:=Module[{l = Table[Length[lin[[i]]], {i, Length[lin]}]},PrependTo[l, 0];
Do[
                l[[i]] += l[[i - 1]], {i, 2, Length[l]}];l];

depthshow[xyz_:  xyz]:=  
Module[{lin  = {},linkends=lineEnds[xyz],xy = Transpose[Take[Transpose[Flatten[xyz, 1]], 2]],z = Transpose[Flatten[xyz, 1]][[3]],zmin,zr},z = (z + RotateLeft[z])/2;zmin = Min[z];zr = Max[z];zr = zr - zmin;If[zr == 0, zr = 1; zmin = zmin - 1];If[pr > 8, 
                  Print[{"z", z, xyz // tf, zmin, zr}]];Do[
                If [! MemberQ[linkends, i], 
                  AppendTo[
                    lin , {Thickness[(z[[i]] - zmin)/50/zr], 
                      Line[{xy[[i]], xy[[i + 1]]}]}]], {i, 
                  Length[xy] - 1}];If[pr > 8, Print[lin ]];Graphics[lin ]];

3.5. Circular knots and links, kn.

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]

kn[n_, dz_:  1/4, dr_:  1/4, 
          dx_:  0]:=  
Module[{sr1 = If[dr == 0, 2, 2  Sign[dr]], 
              sr2 = If[dr == 0, -2, 2  Sign[dr]]},If[
                  n ⩽ 1 || (dr == 0 && Abs[dx] <  .5), 
                  Print [{"Impossible with n=", n, " dr=", dr}]; 
                  Abort[]];
         
If[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}]]},
  {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]}, 
{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]}, 
{i, 0, 
                          2*n  , 1/2}]]}]];

3.6. Braids, braid, ringBraid, loopBraid, reducedBraidList.

3.6.1. Introduction to Braids.

Alexander'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 (Subscript[B, n]) are n 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. 
	They 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 crosscurv.
	A "braid word" such as \(TraditionalForm\`\(σ\_2\) \(σ\_1\) \(σ\_1\) \(σ\_2\%\(-1\)\) σ\_1\)(Subscript[σ, 1]) [4, Ch5] describes a braid as a list of the braids that move up. I describe them as a braidlist, 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 reducedBraidList 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 reducedbraidlist 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.
	reducedBraidList[braidlist] creates a simplified and normalized braidlist and  
lists the links as the strand indices.
	braid[braidlist] creates a linelist that can be processed by curvs or crosscurv as individual threads. ringBraid[braidlist] and loopBraid[braidlist] create a linelist of closed links.
	[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. reducedBraidList can then be used to standardize the result.

3.6.2. braid,ringBraid,loopBraid, reducedBraidList.

Clear[braid, ringBraid, loopBraid,  reducedBraidList];

braid[braidlist_List]:=(*converts braidlist to braids.*)
Module[{e, j, jk, k, l = Length[braidlist], n = 3, oj = 0, 
              ok = 0, p, pj, pk, pjk, pjok, res, s, w, x = 2},If[
                  MemberQ[braidlist, 
                      Null] || ! NumericQ[Plus @@ braidlist], 
                  Print[{"Faulty ", braidlist}]; Abort[]];w = 
                Max[Abs[braidlist]] + 1;p = Range[w];
res = 
                Table[{{0, i, 0}, {1, i, 0}}, {i, w}];
Do[  j = Abs[braidlist[[i]]];
pj = p[[j]];k = j + 1;pk = p[[k]];jk = N[(j + k)/2];If[Length[Union[pjok = {pj, pk, oj, ok}]] == 4 && 
                          Length[pjk] ≠ 4,  x--;res[[pj]] = Most[res[[pj]]];res[[pk]] = Most[res[[pk]]];If[pr > 8, 
                              Print[{"drop", pj, pk}]];pjk = pjok,pjk = {pj, pk}];s = Sign[braidlist[[i]]]/2;If[pr > 8, Print[{j, k, pj, pk}]];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;If[pr > 8, 
                        Print[{"Add cross,x,j,p", x, j, 
                            p, {x -  .49, jk, s}, {x, k, s}, {x -  .51, 
                              jk, -s}, {x, j, -s}}]];
Do[If[res[[e, -1, 1]] == x, (*already crossed and extended*) If[pr > 8, 
                                  Print[{"Do not extend", e, pj, pk}]];  ,AppendTo[res[[e]],{x,res[[e, -1, 2]],res[[e, -1, 3]]}]If[pr > 8, 
                                  Print[{"e,pj,pk,extension", e, pj, 
                                      pk, {x, res[[e, -1, 2]], 
                                        res[[e, -1, 3]]}}]]],{e, w}];oj = pj;ok = pk;
x++,
{i, l}];Do[
                AppendTo[
                  res[[i]], {res[[i, -1, 1]] + 1, 
                    res[[i, -1, 2]], res[[i, 1, 3]]}], {i, w}];res];

loopBraid[braidlist_]:=(*converts braidlist to loopbraid*)
Module[{b = braid[braidlist],i,i2,l,ln,n = {0, 1, 0},res = {{}},todo,w = Max[Abs[braidlist]] + 1   ,x},If[
                  MemberQ[braidlist, 
                      Null] || ! NumericQ[Plus @@ braidlist], 
                  Print[{"Faulty ", braidlist}]; Abort[]];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}};Do[i = 
                      If[MemberQ[todo, n[[2]]], n[[2]], ln++; 
                        AppendTo[res, {}]; Min[todo]];If[pr > 8, 
                        Print[{"n,ii,i", n, ii, i, "todo", todo, 
                            Min[todo]}]];todo = 
                      Drop[todo, Position[todo, i][[1]]];If[pr > 8, 
                        Print[{"n,i,todo", n, i, todo, b[[i, 2]]}]];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;If[pr > 8, Print[{"n,x,i", n, x, i}]];
Do[
                      res[[ln]] = {res[[ln]], l[[j]]}, {j, 
                        Length[l]}],{ii, w}];
Do[
                res[[n]] = Partition[Flatten[res[[n]]], 3]; 
                AppendTo[res[[n]], res[[n, 1]]], {n, Length[res]}];res];

ringBraid[braidlist0_List]:=(*converts braidlist to ringbraid*)
Module[{braidlist,b=reducedBraidList[braidlist0],j,jk,k,l,links,n = 3,oj = 0,ok = 0,p,pj,pjk,pk,pjok,r,res,res1,t,w,x = 1},
braidlist = b[[1]];l = Length[braidlist];links = Transpose[b[[2]]][[1]];If[pr > 8, Print[{"b", braidlist, links}]];If[
                  MemberQ[braidlist, 
                      Null] || ! NumericQ[Plus @@ braidlist], 
                  Print[{"Faulty ", braidlist}]; Abort[]];w = 
                Max[Abs[braidlist]] + 1;p = Range[w];
res = Table[{{0, i, 0}}, {i, w}];
Do[  j = Abs[braidlist[[i]]];
pj = p[[j]];k = j + 1;pk = p[[k]];jk = N[(j + k)/2];If[Length[Union[pjok = {pj, pk, oj, ok}]] == 4 && 
                          Length[pjk] ≠ 4,  x--;res[[pj]] = Most[res[[pj]]];res[[pk]] = Most[res[[pk]]];If[pr > 8, 
                              Print[{"drop", pj, pk}]];pjk = pjok,pjk = {pj, pk}];s = Sign[braidlist[[i]]]/2;If[pr > 8, Print[{j, k, pj, pk}]];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;If[pr > 8, 
                        Print[{"Add cross,x,j,p", x, j, 
                            p, {x -  .49, jk, s}, {x, k, s}, {x -  .51, 
                              jk, -s}, {x, j, -s}}]];
Do[  If[res[[e, -1, 1]] == x, (*already crossed and extended*) If[pr > 8, 
                                  Print[{"Do not extend", e, pj, pk}]];  ,AppendTo[res[[e]],{x,res[[e, -1, 2]],res[[e, -1, 3]]}]],{e, w}];
oj = pj;ok = pk;x++,{i, l}];  
m = 
                res[[-1, -1, 1]];
  n = 0;temp = {};res1 = {};p = Range[w];If[pr > 8, Print[{"Braids", res}]];While[i = Min[p];j = i;n++;  
If[MemberQ[links, i], 
                      temp = {}]  ;While[p = Drop[p, Position[p, i][[1]]]; 
                      temp = {temp, Most[res[[i]]]}; 
                      i = res[[i, -1, 2]]; j ≠ i,];temp = Partition[Flatten[temp], 3];
AppendTo[temp, temp[[1]]]  ;
AppendTo[res1, temp];
Length[p] > 1,];  
res = {};  ;If[pr > 8, 
                  Print[{"m, length, Links", m, Length[res1], res1}]];
Do[AppendTo[res, {}]  ;Do[t = N[2  π 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]]}]};
, {j, 
                        Length[res1[[i]]]}];res[[i]] = 
                      Partition[Flatten[res[[i]]], 3]
,{i, Length[res1]}];
;res];

reducedBraidList[braidlist_List]:=(*converts braidlist to reduced (normal) form, reports number of links,reduces non - trivial components*)
Module[{r = braidlist, i, j = 0, l, lf, m, mx = 0, p, up, 
            w = Max[Abs[braidlist]] + 1},If[
                MemberQ[braidlist, 
                    Null] || ! NumericQ[Plus @@ braidlist], 
                Print[{"Faulty ", braidlist}]; Abort[]];If[pr > 8, Print[{"r", r}]];  
While[j ≠ Length[r] && mx ≠ Length[r],mx = Length[r];j = Length[r];If[(l = 
                            Complement[Range[w - 1], 
                              Union[Abs[r]]]) ≠ {},Print[{"Unlinked, Missing ", l, 
                            Union[Abs[r]]}]];If[pr > 8, Print[{"r,j,w", r, j, w}]];  
If[Length[l = Position[Abs[r], 1]] == 1,w--;j--;If[pr > 0, 
                            Print["Drop single 1 from", 
                              r, "in position", l]];r = 
                          Drop[r, l[[1]]];r = 
                          Table[(Abs[r[[i]]] - 1) 
                              Sign[r[[i]]], {i, Length[r]}];If[pr > 8, 
                            Print[{"After drop 1, r,j,w", r, j, w}]];];
If[Length[l = Position[Abs[r], w - 1]] == 
                        1,w--;j--;If[pr > 0, 
                            Print[{"Drop", w, "from", 
                                r, "in position", l}]];r = 
                          Drop[r, l[[1]]];If[pr > 8, 
                            Print[{"After drop w, r,j,w", r, j, w}]];];
  l = j;While[j > 1,If[pr > 8, 
                            Print[{"j,rj-1,rj", j, r[[j - 1]], 
                                r[[j]], mx}]];If[r[[j - 1]] == -r[[j]],r = Drop[r, {j - 1, j}];If[pr > 8, 
                                  Print[{"Drop j,l,r", j, l, r}]];l -= 2;j--];j--];
 (*Now swap disjoint pairs to maximize u*) j = Length[r];
While[j > 2,If[(l = Abs[r[[j]]]) > (m = 
                                    Abs[r[[j - 1]]]) && 
                              Abs[l - m] > 1 ,r = 
                                Insert[Drop[r, {j}], r[[j]], {j - 1}];If[pr > 8, 
                                  Print[{"swap    ", j, l, m, r}]];];j--];
  m = 
                    Position[Abs[r], Max[Abs[r]]];
r = Sort[
                        Table[RotateLeft[r, m[[i, 1]] - 1], {i, 
                            Length[m]}], 
                        OrderedQ[{Abs[#1], Abs[#2]}] &][[-1]];If[r[[1]] < 0, r = -r];
If[pr > 8, Print[{"rotated r", r}]];
j = 0];  
  p = Table[i, {i, w}];
Do[up = p[[(k = Abs[r[[j]]])]];p[[k]] = p[[k + 1]];p[[k + 1]] = up;If[pr > 8, Print[{"k,p", k, p}]];,{j, Length[r]}];
  l = {};j = 0;
While[lf = 
                  Flatten[l]; (lf = Complement[p, lf]) ≠ {},
j = Min[lf];AppendTo[l, {j}];m = p[[j]];While[m ≠ j,AppendTo[l[[-1]], m];
m = p[[m]];If[pr > 8, 
                            Print[{"j,m,l", j, m, l}]]]
];If[pr > 0, 
                Print[{"No of links = ", Length[l], 
                    l, "\nNo of nodes = ", Length[r]}]];
;{r, l}]

3.6.3.  braidlist restrictions to describe simple knots.

For a normalized braidlist to describe a simple knot it must meet strict requirements.
	Preliminary conjectures, for braids with b+1 strands and c crossings:-
(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.
(2) {n,-n} pairs can be eliminated (R2 move).
(3) {n,m} pairs can be converted to {m,n} if |m|>|n| to maximize the sequence (R3 move).
(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.
(4) b=2 only provides torus knots {1,1 ....}.
(5) No missing numbers are allowed as they disconnect the diagram into loops.
(6) No "singletons" (numbers that appear only once) are allowed as they give composite knots.

3.6.4. Generalizations.

Composite 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
	Instead 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.
	Braids can be tubular, with some crossings between top and bottom strands. This could be shown by zeroes in the knot list. Not explored.
	Ashley has many pages on single-strand lanyard and button knots, and more on multi-strand confections; many of these are capped braids.

3.7. Rotating Knots rxyz, rx4, rx3, etc., rxyz4, rxyz3.

Matrices are provided to rotate 3 or 4D lines by angles {x,y,z} in the anticlockwise direction.

x =. ; y =. ; z =. ; 
    Clear[ryz, rx3, rx4, ry3, ry4, rz3, rz4, rxyz3];

ryz[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]}};

rx4(x_):=(({{1, 0, 0, 0}, {0, cos(x), -sin(x), 0}, {0, sin(x), cos(x), 0}, {0, 0, 0, 1}}))

rx3(x_):=(({{1, 0, 0}, {0, cos(x), -sin(x)}, {0, sin(x), cos(x)}}))

ry4(y_):=(({{cos(y), 0, -sin(y), 0}, {0, 1, 0, 0}, {-sin(y), 0, cos(y), 0}, {0, 0, 0, 1}}))

ry3(y_):=(({{cos(y), 0, -sin(y)}, {0, 1, 0}, {-sin(y), 0, cos(y)}}))

rz4(z_):=(({{cos(z), -sin(z), 0, 0}, {sin(z), cos(z), 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}))

rz3(z_):=(({{cos(z), -sin(z), 0}, {sin(z), cos(z), 0}, {0, 0, 1}}))

rxyz3[l_, x_, y_, z_]:=Table[l[[i]].rx3[x].ry3[y].rz3[z],{i, Length[l]}];

rxyz4[l_, x_, y_, z_]:=Table[l[[i]].rx4[x].ry4[y].rz4[z],{i, Length[l]}];

3.8. Conway notation, kConway, pf3, Pretzel Knots kpretzel.

See Section 2.13 for a discussion of Conway's notation, tangles, and continued fractions. kConway works on a case-by-case basis, but only handles data as strings of up to 3 integers, e.g."332". kpretzel handles data in the form {i,j,..}.

ConwayUnpack, kConway.

kConway uses ConwayUnpack to create a list that can be plotted as a knot or link. Four-element and 6* (etc) Conway notation not implemented.

Clear[ConwayUnpack, kConway, kpretzel];

ConwayUnpack[c_String, f_:  False]:=Module[{a = {}, aa},If[pr > 1, Print[{"Unpack c", c}]];Do[aa = StringTake[c, {i}];(* Unpack Conway - notation *)
Which[aa == ",",AppendTo[a, 0],
aa == "-",If[i == 1, 
                              Print [{"Cannot start with -"}]; 
                              Abort[]];a[[-1]] *= -1,
aa == "+",AppendTo[a, 1],
(aa == "*" || 
                            aa == "."),Print[{c, " Not implemented"}]; Abort[],
IntegerQ[
                          ae = ToExpression[aa]],AppendTo[a, ae],
True,Print[{c, " Not implemented"}; 
                          Abort[]]],
{i, StringLength[c]}];
If[IntegerQ[Plus @@ a], , 
                  Print ["Faulty data ", a]; Abort[]];
If[l == 1, Print [{"Use kn[", a, "]"}]; 
                  Abort[]];If[f, 
                Print[{a, "Continued Fraction =", 
                    FromContinuedFraction[Reverse[a]]}]];a];

pf3[a_] := Partition[Flatten[a], 3];
kConway[c_String, f_:  False]:=
  
Module[{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},
apm = ConwayUnpack[c, f];a = Abs[apm];
l = Length[a];hv = 1 - 2  Mod[l, 2];
evnod = 
                Table[Mod[a[[i]], 2], {i, l}];If[pr > 8, 
                  Print[{"apm,l,hv,evnod", apm, l, hv, evnod}]];  
Do[  hv *= -1 (*switch horizontal/vertical.*) ;
v = 
                      Max[- hv, 0];h = Max[ hv, 0];
If[(aa = a[[j]]) == 0  ,If[v == 1,x = xold; y = my + 2; 
                            yold = y,
  y = yold; 
                            x = mx + 2; xold = x],If[pr > 8, 
                              Print[{"h,v,x,y,xold,yold", h, v, x, y, 
                                  xold, yold}]];  
ae = 
                            If[EvenQ[aa], 1, -1];as = Sign[apm[[j]]];temp1 = {};temp2 = {};
Do[dx = d[[Mod1[i, 4]]];   
dy = 
                                  d[[Mod1[i + 2, 4]]];  
dz = 
                                  d[[Mod1[i + 1, 4]]];  
temp1 = {temp1, {x + i h + v dx, 
                                      y + i v - h  dy, as dz}};
temp2 = {temp2, {x + i h - v dx, 
                                      y + i v + h  dy, -as dz}};
mx = 
                                  Max[x + i h + 1, mx];my = Max[y + i v + 1, my]
,{i, 0, 2  aa}];  
AppendTo[res, 
                            pf3[temp1]];AppendTo[res, pf3[temp2]];If[pr > 8, 
                              Print[{"lnk1,2", lnk1, lnk2}]];
If[h == 1,xt = mx; yr = my; 
                              yb = my - 2; x = Floor[(xl + xt)/2]; 
                              y = Max[yl, yt] + 1,
   xt = mx; 
                              xl = mx - 2; yt = my; yl = my; xold = x; 
                              x = Max[xb, xt] + 1; yold = y; 
                              y = Floor[(yt + yb)/2]]  ;
]  
,{j, l}];  
If[pr > 0, 
                  Print[{"done,\n  l,mx,my\n", l, mx, my, "\n", 
                      res}]];
  
tl = {2, my + 1, 0};tr = {mx - 2, my + 1, 0};bl = {2, 0, 0};br = {mx - 2, 0, 0};tmp = res;  
Which[evnod == {0},res[[1]] = pf3[{bl, res[[1]], br, bl}]; 
                  res[[2]] = pf3[{tl, res[[2]], tr, tl}]
,evnod == {1},res = {pf3[{bl, res[[1]], tr, tl, res[[2]], 
                          br, bl}]}
,evnod == {0, 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}]}
,evnod == {0, 1},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}]}
,evnod == {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}]}
,evnod == {1, 1},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}]
,evnod == {0, 0, 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}]
,evnod == {0, 0, 1},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}]}
,evnod == {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}]
,evnod == {0, 1, 1},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}]}
,evnod == {1, 0, 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}]}
,evnod == {1, 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}]}
,evnod == {1, 1, 1},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}]}
,evnod == {1, 0, 1},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]]}],
True,];
res];

kPretzel.

Pretzel 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 kpretzel[a], 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 kpretzel.

kpretzel[a_: {3, 3, 3}]:=  
Module[{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}},
If[l < 3, Print ["Use kn"]; Abort[]];
If[EvenQ[l] && OddQ[a[[-1]]], 
                  Print ["Not a knot or faulty data ", a]; Abort[]];
If[IntegerQ[Plus @@ a], , 
                  Print ["Faulty data ", a]; Abort[]];  
mn = Min[Union[Abs[a]]];mx = Max[Union[Abs[a]]];If[pr > 8, Print[{a, l, mn, mx, n}]];
halves = Table[{}, {i, 2  l}];  
x1 = 3  l - 5/2;x4 = x1;If[evn == 2 && OddQ[l], x3 = x1; x4 = 2, xt = 2];
Do[If[EvenQ[a[[j]]] && j ≠ l, 
                        Print [{"Only 1 even crossing allowed, at end", 
                            a}]; Abort[]];
dy = 
                      mx - Abs[a[[j]]];  
Do[dx = xd[[Mod1[i, 4]]];  
dz = 
                            Sign[a[[j]]] zd[[Mod1[i, 4]]];  
AppendTo[
                            halves[[2  j - 1]], {3  j + dx - 2, i + dy, 
                              dz}];
AppendTo[
                            halves[[2  j]], {3  j - dx - 2, 
                              i + dy, -dz}],{i, 0,   2  Abs[a[[j]]]}],
{j, l}];  
AppendTo[
                halves[[xt]], {x3, 2  mx + 1, 0}];
AppendTo[
                halves[[xt]], {x4, 2  mx + 1, 0}];
jj = seq[[l, evn]];  
Do[
                h = halves[[jj[[j]]]]; If[EvenQ[j], h = Reverse[h]]; 
                Do[AppendTo[res, h[[i]]], {i, Length[h]}], {j, 
                  Length[halves]}];  
AppendTo[res, {x1, -1, 0}];
AppendTo[res, {x2, -1, 0}];AppendTo[res, res[[1]]];{res}];

3.9. K2K links, blistToBword, K2KShow, nodeListToPdata, PdataToNodeList, blistDrawKnot, blistFromK2K, plistFromK2K.

Prof. 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 OpenGLDraw. It can be downloaded from [13] and unpacked into the Mathematica directory. OpenGLDraw.dll and glut32.dll may need to be included. To allow access from KnotsEtc, save knotbycomp.nb in addons\extrapackages. Change the line Uninstall[link]; in ShowKnotfromPdata to Uninstall[link];If[s==2,ll=mm]; so that ShowKnotfromPdata[plist,2] puts the linelist into the global variable ll without drawing the knot. Then create knotbycomp.m.
	The following instruction should now make the K2K routines and data available.

SetDirectory["C:\Program Files\Wolfram \
Research\Mathematica\K2K1_3_3"]
<< knotbycomp.m

The following procedures are demonstrated in Examples 36-44.
K2K [13] uses  bword, the most compact braid descriptor, using the letters a-k for overpasses, A-K for underpasses. The K2K function bwdtonumwd[bword_String] creates a braidlist. The reverse operation is:-

blistToBword[l_List] := 
        Module[{a, ll = Length[l], B = "", n = "abcdefghijk", 
            N = "ABCDEFGHIJK"}, 
          Do[a = l[[i]]; 
            If[a > 0, B = B <> StringTake[n, {a}], 
              B = B <> StringTake[N, {-a}]], {i, ll}]; B];

K2K uses "plist" notation for knots. It is the list  {{number of crossings for each component}, {signed crossing index for the underpasses for each crossing}}

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]];

K2KShow uses nodeListToPdata to give the K2K plot of a lineList:-

K2KShow[line_List] := 
      ShowKnotfromPdata[crosscurv[line]; 
        nodeListToPdata[nodeList]]

pdataToNodeList[pl_List]:=  
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]]; 
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;, 
{i, 
                lj}]; 
AppendTo[q, 
              p], 
{j, l}]; q];

blistDrawKnot[] := 
        Module[{}, pdata  =  GetPdatabyTracking[]; 
          bword = GetBraidRep[pdata]; bwordToblist[bword]];

Individual pList and bword data is recovered from the Thistlethwaite files of non-alternate knots with 9 to 16 crossings:-

\(plistFromK2K[cr_Integer:  10, 
        pos_Integer:  
          1] :=  (*Accesses\ 201691\ knots\ with\ 9\ to\ 15\ crossings*) 
	
      Module[{str = "nonalternate" <> ToString[cr] <> ".PRD", temp}, 
        If[cr < 10 || cr > 15 || cr == 10 && pos > 42 || 
            cr == 11 && pos > 185 || cr == 12 && pos > 888 || 
            cr == 13 && pos > 5110 || cr == 14 && pos > 27436 || 
            cr == 15 && pos > 168030, 
          Print["No data ", cr, " ", pos]; 
          Abort[]]; 
temp = 
          ReadList[str, Number, \((3 + cr)\)\ pos, 
            RecordLists -> True]; 
If[temp == $Failed, 
          Print["Cannot open ", str]; 
          Abort[]]; 
{temp[\([\(-2\)]\)]/2, 
          temp[\([\(-1\)]\)]}
]\)

\(blist[cr_Integer:  10, p_Integer:  1] := 
	
      Module[ (*426213\ braids\ for\ knots\ with\ 9\ to\ 16\ crossings*) \ {str = "nonalternate" <> ToString[cr] <> ".brd", pos = p, 
          temp}, 
If[
          cr > 3 && cr < 10 && 
            Length[genKnot[\([cr]\)]] ⩾ p, 
          temp = {blistToBword[
                genKnot[\([cr, p, 6]\)]]}, 
Which[
            cr == 15 && pos < 65007, 
            str = "nonalternate15_1.brd", 
cr == 
                15 && pos < 103026 + 65006, pos = pos - 65006; 
            str = "nonalternate15_2.brd", 
cr == 
                16 && pos < 112126, 
            str = "nonalternate16_1.brd", 
cr == 
                16 && pos < 224521, str = "nonalternate16_2.brd"; 
            pos = pos - 112125, 
True, 
            If[cr < 10 || cr > 14 || cr == 10 && pos > 42 || 
                cr == 11 && pos > 185 || cr == 12 && pos > 888 || 
                cr == 13 && pos > 5110 || 
                cr == 14 && pos > 27436, 
              Print["max data exceeded ", Length[temp] - 1, " ", 
                cr, " ", p]; Abort[]]]; 
          temp = ReadList[str, String, pos]; 
If[
            temp == $Failed, Print["Cannot open ", str]; Abort[]]]; 
        temp[\([\(-1\)]\)]
]\)

4. Elementary Knot Theory.

4.1. Mathematical Knots and Knot Invariants.

The 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. 
	This 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.
	Knot 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 crossings 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.
	The crossings & crosscurv procedures assigns two signed crossing numbers (under and over) to each crossing, in the nodeList. 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. nodeList can be manipulated to give the Dowker-Thistlethwaite name, the writhe, etc.

4.2. Crossing identification.

4.2.1. Discussion.

curvs generates xyz as the coordinate list of the chord starting nodes, with a specified starting point. xyz is the basic data needed for the crossing identification procedure. crossings[] (or crossings[xyz]) uses it to find and label crossings, using chordno→2 (two chords between points) for speed of execution. (crosscurv[List] provides a shortcut, first calling curvs with suitable options. It also prints out the crossing matrix if pr =1 or 2, and the Dowker notation for knots if pr =2 or 3.)
	Both instances of the chord numbers of each crossing found in traversing the oriented loops are stored in nodeList; 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 chxyz. Points are indexed in order, with the same sign convention, in nodeList. Finally they are put ino the Graphics object cr, with the crossing indices pts superimposed. (curvs shows point indices, not crossing indices, on lines.) There is an outstanding problem with links.

Crossing procedure.
curvs with rad->0 creates xyz as a list of one or more lines, sets of points with 3 coordinates x, y, z. 
xyz is the argument for crossings. It is flattened to give XYZfl, an ordered list of all the points.
Adjacent points in a line define a chord. If the last point coincides with the first, the line is a loop.
Every 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.
linlen is a list of last indices (in XYZfl) for each line. It is used to identify the (non-chord) jumps between successive lines.
The l loop treats each line in turn. linlen is used to find XYZline, the points in the line.
The 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
The 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 ≥1. (=1 is at the beginning of the next chord.)
The underpass and the orientation are found, and node is built up as {-j unov, i ori, location} items. This is sorted into snode by |first number|. The location goes into chxyz. nodeList 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. nodpos then plots the indices to the left of the crossing, with the (unsigned) overpass index above the underpass index (signed with the orientation). Finally, cr is created as a Graphics object by plotting nodpos and the chords, which have thickness proportional to z.

4.2.2. crosscurv, crossings, lineEnds.

Clear[lineEnds, crosscurv, crossings]; xyz =. ;

lineEnds[lin_]:=Module[{l = Table[Length[lin[[i]]], {i, Length[lin]}]},PrependTo[l, 0];
Do[
                l[[i]] += l[[i - 1]], {i, 2, Length[l]}];l];

crosscurv[lines_?ListQ, opts___Rule : {}] :=Module[{},curvs[perturb[lines],rad -> 0,chordno -> 2];crossings[xyz, opts];If[pr == 1 || pr == 3,Print[{"linkMatrix",linkMatrix[]}]];If[pr == 2 || pr == 3 && Length[lines] == 1,Print[{"Dowker Name",dowth[]}];];If[pr ⩾ 0, Show[cr]];];

crossings[xyz_List, 
          opts___Rule : {}]:=  
Module[{a,aa,b,bb,len,linlen=lineEnds[xyz],d = Length[xyz[[1, 1]]],ii,iii,jj = -3,jjj,l,lcount,m,node = {},ori,snode,unov,z,XYZline,XYZfl = Flatten[xyz, 1]},  If[pr > 8, 
                  Print[{"linlen", linlen, "\nxyz=", 
                      xyz, "\nXYZfl=", XYZfl}]];
nodpos = {};chxyz = {};siz = Max[XYZfl] - Min[XYZfl];
Do[  XYZline = 
                      Take[XYZfl, {linlen[[l - 1]] + 1, 
                          linlen[[l]]}];lcount = 0;
If[pr > 8, 
                        Print[{l, 
                            linlen[[l]], "=l,L[l],new XYZline, lengths=\
", XYZline, Length[XYZline]}]];
  
Do[  
iii = i + linlen[[l - 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]]];If[pr > 8, 
                              Print[{"i,xy1,xm,xy2,ym,z1,z2", i, xy1, 
                                  xmin, xmax, xy2, ymin, ymax, z1, z2}]];
 j = linlen[[l - 1]] + i;  
While[j++; j < Length[XYZfl],
    XY1 = Take[XYZfl[[j]], 2];XY2 = Take[XYZfl[[j + 1]], 2];  
If[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,Goto[skip]];
a =. ;b =. ;If[pr > 8, 
                                    Print[{i, i + linlen[[l - 1]], j}]];
 z = 
                                  FindInstance[
                                    aa xy1 + (1 - aa) xy2 == 
                                      bb XY1 + (1 - bb) XY2, {aa, bb}];If[pr > 8, 
                                    Print[
                                      Chop[{"i,j,new chord", i, j, XY1, 
                                        XY2, z}]]];
 If[z != {},  
a = (aa /. z)[[1]]; 
                                    b = (bb /. z)[[1]],a = -1; b = -1];
If[pr > 8, 
                                    Print[
                                      Chop[{"a,b", a, 
                                        b, (a ≥ 0), (a < 
                                        1), (b ≥ 
                                        0), (b < 1)}]]];
 If[(a ≥ 
                                        0) && (a < 
                                        1) && (b ≥ 
                                        0) && (b < 1),jj = j;lcount++;
  
If[pr > 8, 
                                        Print[
                                        Chop[{"Found i,j,a,b", i, j, a, 
                                        b, "z1,z2,z3,z4", z1, z2, 
                                        XYZfl[[j, 3]], 
                                        XYZfl[[j + 1, 3]]}]]];
unov = -1;
If[  d > 
                                        2 && (a z1 + (1 - a) z2 > 
                                        b XYZfl[[j, 3]] + (1 - b) 
                                        XYZfl[[j + 1, 3]]), unov = 1];
  
xya = 
                                        XY2 + xy1 - XY1;
If[pr > 8, 
                                        Print[
                                        Chop[{"xya", xya, "xy1,xy2", 
                                        xy1, xy2}]]];
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];
 (*Add crossing to node*) 
AppendTo[
                                        node, {iii unov, j ori, a}];AppendTo[
                                        node, {-j unov, iii ori, a}];
  ];
Label[skip]  ],{i, Length[XYZline] - 1}];
  
,{l, 2, Length[linlen - 1]}];
len = Length[node];If[len == 0, Print["No crossings."]; 
                  Abort[]];If[pr > 8, Print[{"node", node // tf}]];
snode = Sort[node, OrderedQ[{Abs[#1], Abs[#2]}] &];chxyz = 
                Partition[Flatten[Transpose[Take[Transpose[snode], -1]]], 
                  2];If[pr > 8, Print[{"snode", snode // tf}]];snode = 
                Transpose[Take[Transpose[snode], 2]];If[pr > 8, Print[{"snode", snode // tf}]];
jj = 1;jjj = Abs[snode];   
nodeList = Table[{}, {j, Length[linlen]}];j = 1;Do[AppendTo[nodeList[[j]],a = snode[[i, 1]];b = snode[[i, 2]];If[Abs[a] > linlen[[j]], j++  ];
       {i Sign[a], 
                          Sign[b] Position[jjj, Abs[{b, a}]][[1, 
                                1]]}],{i, len}];nodeList = Rest[nodeList];If[pr > 8, Print[{"nodeList", nodeList}]];
Do[AppendTo[nodpos,  {{GrayLevel[1], 
                          Disk[chxyz[[i]], siz/48]}}],
{i, len}];
Do[a = Sign[snode[[i, 1]]];b = Sign[snode[[i, 2]]];If[a > 0, b = 1];AppendTo[nodpos,  {
Hue[0], 
                          Text[i b, 
                            chxyz[[i]] - {0, -siz*a/96}]}],
{i, len}];If[pr > 8, Print[{"nodpos", nodpos}]];
  	
$DisplayFunction  =  Identity;cr=Show[depthshow[xyz],Graphics [nodpos],AspectRatio -> Automatic,opts]; $DisplayFunction  =  Display[$Display,  #1]  & ;
cr];
crossings[]:=If[ListQ[xyz],crossings[xyz],Abort[]];

4.3. Simplification by Reidermeister Moves.

4.3.1. Discussion.

Reidermeister 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 α.

4.2.2. R1, R2, R3, Rtidy.

Clear[R1, R2, R3, Rtidy]; nodeList =. ;

R1[sno_:  nodeList, n_:  999]:=  
Module[{a, b, m = n, nn, t, i, j},If[
                Head[sno] == Symbol || Flatten[sno] == {}, 
                Print[{"Error in",  sno}]; Return[]];t = 
              Transpose[Flatten[sno, 1]];
  
a = AppendTo[t[[1]], t[[1, 1]]];b = AppendTo[t[[2]], t[[2, 1]]];  
If[pr  > 1, Print[{"R1 t", t, a, b}]];
i = 1;While[i < Length[a],
If[pr > 8, 
                      Print[{"R1 i", i, ",a,b", a[[i]], 
                          b[[i + 1]], b[[i]], 
                          a[[i + 1]], "l=", Length[a]}]];If[Abs[a[[i]]] == Abs[b[[i + 1]]] && 
                        Abs[b[[i]]] == Abs[a[[i + 1]]],  
a = Drop[a, {i}];a = Drop[a, {i}];b = Drop[b, {i}];b = Drop[b, {i}];If[pr > 8, 
                            Print[{"R1 new a,b", a, b}]];If[m = m - 1; m < 1, i = 9999];
i -= 1];
i++];Rtidy[a, b]]

Rtidy[a_, b_]:=Module[{u, d, j, nn = Transpose[{a, b}], newnodes},j = Abs[nn];If[pr  > 8, 
                  Print[{"Rtidy a,b", {{a, b}} // tf}]];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}];

When two nodes have adjacent first and second indices, and the same unov, 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.

R2[sno_:  nodeList, n_:  999]:=  
Module[{a, b, t, i, j, m = n, nn},If[
                Head[sno] == Symbol || Flatten[sno] == {}, 
                Print[{"Error in",  sno}]; Return[]];
t = 
              Transpose[Flatten[sno, 1]];
  
a = AppendTo[t[[1]], t[[1, 1]]];b = AppendTo[t[[2]], t[[2, 1]]];If[pr  > 8, 
                Print[{"R2 t", t, "a,b", a, b}]];
i = 1;While[i < Length[a] && Length[a] > 3,If[pr > 8, 
                      Print[{"R2 i", i, "a,b", a, b}]];  
If[(Sign[a[[i]]] == 
                            Sign[a[[i + 1]]]) && (Abs[
                              Abs[b[[i]]] - Abs[b[[i + 1]]]] < 2),  If[pr > 8, 
                            Print[{"R2 found,m,i", m, 
                                i, "ai,ai+,bi,bi+", a[[i]], 
                                a[[i + 1]], b[[i]], 
                                b[[i + 1]]}]];
      j = Position[Abs[a], 
                                Min[Abs[b[[i]]], 
                                  Abs[b[[i + 1]]]]][[1, 1]] - 2;If[pr > 8, Print[{"R2 j", j}]];
a = Drop[a, {i}];a = Drop[a, {i}];
         b = Drop[b, {i}];b = Drop[b, {i}];
If[j > 0,  
                          a = Drop[a, {j}]; a = Drop[a, {j}];  
                          b = Drop[b, {j}]; b = Drop[b, {j}]];If[pr > 8, 
                            Print[{"R2 new a,b", a, b}]];If[m = m - 1; m < 1, i = 9999];
      i -= 1];
i++];Rtidy[a, b]]

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.

R3[sno_:  nodeList, n_:  1]:=  
Module[{a, b, t, nn, i, j, res},If[
                Head[sno] == Symbol || Flatten[sno] == {}, 
                Print[{"Error in",  sno}]; Return[]];t = 
              Transpose[Flatten[sno, 1]];If[pr  > 8, Print[{"R3 t", t // tf}]];  
a = AppendTo[t[[1]], t[[1, 1]]];aa = Abs[a];b = Abs[AppendTo[t[[2]], t[[2, 1]]]];res = sno[[1]];(*Find and reverse a |× crossings after node n*)
i = n;While[i < Length[a],b1 = b[[i]];b12 = b1 + 1;b2 = b[[i + 1]];b21 = b2 + 1;If[pr  > 8, 
                      Print[{"i,ab1,ab2", i, a[[i]], b1, 
                          a[[i + 1]], b2}]];If[(Sign[a[[i]]] == Sign[a[[i + 1]]]) && 
                        Which[
Abs[
                                b[[b1]] - b2] == 1 && 
                            Abs[b[[b21]] - b1] == 1, 
                          True, 
b11 = b1 - 1; 
                          Abs[b[[b11]] - b2] == 1 && 
                            Abs[b[[b21]] - b1] == 1, 
                          True, 
b21 = b2 - 1; 
                          Abs[b[[b11]] - b2] == 1 && 
                            Abs[b[[b21]] - b1] == 1, 
                          True, 
b11 = b1 + 1; 
                          Abs[b[[b11]] - b2] == 1 && 
                            Abs[b[[b21]] - b1] == 1, 
                          True, 
True, False],If[pr  > 8, 
                            Print[{"i", i, "b1,b2", b1, 
                                b2, "b11,b21", b11, b21, }]];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
,If[pr  > 8, Print[{"i False", i, }]];
];
i++];{res}]

4.4. Dowker-Thistlethwaite notation, linkMatrix, writhe, bridgeCount.

4.4.1. Discussion.

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 nodeList pairings gives dtn, the location of possible starting nodes; this is used to find the largest list. As a negated knot may have a different DT name, dowth[-nodeList] should also be calculated. dowthl handles links, giving a list containing a sub-list for each loop.
K2K includes a procedure to create knots from the Dowker-Thisthlethwaite name  (See Example 21 and Section 5.4.) :-

dowth[Adamsfig29]
ShowKnotfromPdata[KnotbyDT[%]];

4.4.2. dowthl, dowth, linkMatrix, bridgeCount, pf, writhe.

nodeList =. ; Clear[writhe, dowth, linkMatrix, bridgeCount];

pf[a_, n_:  2]:=Partition[Flatten[a], n]

dowthl[nodes_List]:=   Module[{a, b, dt, linlen = lineEnds[nodes], pn = pf[nodes], 
            res = {}},a = Transpose[pn][[1]];b = Abs[Transpose[pn][[2]]];If[pr > 8, 
                Print[{"a,b", a, b, "linlen", linlen}]];
   Do[  l0 = linlen[[j - 1]] + 1;l1 = linlen[[j]];AppendTo[res, {}];
Do[  AppendTo[
                      res[[-1]], -b[[i]] Sign[
                          a[[i]]]], 
{i, 
                      linlen[[j - 1]] + 1, linlen[[j]], 2}],{j, 2, Length[linlen]}];res]
dowthl[]:=If[ListQ[nodeList],dowthl[nodeList],res];

dowth[nodes_List]:=   Module[{a, b, linlen = lineEnds[nodes], pn = pf[nodes], 
              res = {}},a = Transpose[pn][[1]];b = Abs[Transpose[pn][[2]]];If[pr > 8, 
                  Print[{"a,b", a, b, "linlen", linlen}]];
   Do[  l0 = linlen[[j - 1]] + 1;l1 = linlen[[j]];
Do[  AppendTo[
                        res, -b[[i]] Sign[
                            a[[i]]]], 
{i, 
                        linlen[[j - 1]] + 1, linlen[[j]], 2}],{j, 2, Length[linlen]}];res];
dowth[]:=If[ListQ[nodeList],dowth[nodeList],res];

linkMatrix[sno_List]:=Module[{a, b, l = Length[sno], j1 = 1, l1 = 1, 
            linlen = lineEnds[sno], res, 
            sn = Flatten[sno, 1]}, 
If[l == 0, 
            res = {{}}, 
res = 
              Table[0, {i, l}, {j, l}]; 
Do[
              b = sn[[i, 2]]; a = Abs[b]; j1 = 0; 
              While[a > linlen[[j1 + 1]] && 
                  j1 < l, j1++]; 
a = Max[l1, j1]; 
              c = Min[l1, j1]; 
res[[c, a]] += Sign[b]; 
              If[c ≠ a, res[[a, c]]++]; 
              If[MemberQ[linlen, i], l1++], {i, Length[sn]}]]; 
          res/2 // tf];
linkMatrix[]:=If[ListQ[nodeList],linkMatrix[nodeList],Abort[]];

The writhes are the sums of the signs of the orientations of the crossings of individual link. The diagonal of linkMatrix gives the writhe of each component.

writhe[nod_List]:=Plus @@ 
          Table[Sign[nod[[1, i, 2]]], {i, Length[nod[[1]]]}];writhe[]:=If[ListQ[nodeList],writhe[nodeList],Abort[]];

writhelink[nod_List]:=Table[linkMatrix[nod][[1, i, i]], {i, 
            Length[nod]}];writhelink[]:=If[ListQ[nodeList],writhelink[nodeList],Abort[]];

bridgeCount[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];
bridgeCount[]:=If[ListQ[nodeList],bridgeCount[nodeList],Abort[]];

4.5. Knot Graphs.

4.5.1. Discussion.

In "chequered" knot diagrams, black regions alternate with white, the "outside" being white.
	knotGraph[nodelist,par] 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 Abs[par] (typically 1.2) to improve appearance.   The argument blk=Sign[par] is ±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. 
	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). Show[kgshow] shows the vertices and edges superimposed on the graph shadow. A simplified graph is output as a Combinatorica  graph object kgraf, which can be shown via ShowGraph[kgraf]. Loops with no crossings are {{0,0}}; they become isolated vertices near the centre of  kgraf but are omitted from kgshow.

4.4.2. knotGraph.

ER = EdgeColor -> 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";

nodeList =. ; Clear[knotGraph];

knotGraph[nodes_List,  par_:  1.2]:=  
Module[{a = Abs[Transpose[pf[nodes]][[2]]],b,blk = Sign[par]  ,c,id,d,dir,j,k,l,mxy = Plus @@ chxyz  ,pn = pf[nodes]  },
bl = {};l = Length[pn];mxy = mxy/l;id = Table[Min[Abs[pn[[i]]]], {i, l}]  ;s = Table[Sign[pn[[i, 1]] pn[[i, 2]]], {i, l}];vrtx = {};edgs = {};comb1 = {};comb2 = {};If[pr > 8, Print[{"id,a", id, a, mxy}]];  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}];
Do[b = {id[[i]]}; j = i + 1; 
                b = {}; k = 0; dir = blk; 
                od = If[OddQ[i], 
                    1, -1]; 
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,]; 
b = Sort[b]; 
                If[MemberQ[bl, 
                    b], , AppendTo[bl, b];];
, {i, 
                  l - 1}];l = Length[bl];If[pr > 8, Print[{"bl", bl, l}]];
  
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];
  
Do[Do[ee = Intersection[bl[[i]], bl[[j]]];If[pr > 8, 
                            Print[{"edges", i, j, ee}]];Do[If[pr > 8, 
                                  Print[{"vtx,crossing,vrtx", 
                                      bxy[[i]], chxyz[[k]], 
                                      bxy[[j]]}]];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 -> False, 
                                  PlotJoined -> True]],{k, Length[ee]}],
{j, i + 1, l}],
{i, l - 1}];kgshow = {gcurv, vrtx, edgs};
$DisplayFunction  =  Display[$Display,  #1]  & ;
kgraf = Graph[comb1, comb2]];
knotGraph[par_?NumberQ]:=If[ListQ[nodeList],knotGraph[nodeList, par],res];
knotGraph[]:=If[ListQ[nodeList],knotGraph[nodeList, 1.3],res];

knotGraph procedure.
Remove isolated links. For each node i but the last, put id[[i]] (the smaller of the node indices) into b, advance to j=i+1. (id has to be used to identify a node, as each node has two indices.)
While Loop; j0=j. Find the absolute value of the node's other index j=a[[j0]] and its sign s[[j0]]. This is + if j is on the overpass to a +ve node, or the underpass to a -ve node. In each case the next node is j=j0+od dir s[[j0]] ; od makes it alternately on the left & right. (dir is updated each time.) If j is new, add id[[j]] to b. Repeat (unless k shows an error) until j0=i.
Sort b, and add to bl if not already there. (A more efficient, non-exhaustive, search is desirable!) Convert bl to points at the mean of the location of the nodes. (Scaled by Abs[par] from the centroid as a crude correction for crescentic 2-node regions etc). Create signed edges between the vertices and through the nodes. kgshow superimposes the graph on the crosscurv graph gcurv, with edges passing through the appropriate nodes, and can be seen via Show[kgshow]. The output is a Combinatorica graph kgraf, which can be shown via ShowGraph[kgraf].
The procedure fails with some knots, and with links - unsolved problem.

4.6. Kauffman Bracket, Jones Polynomial, Etc.

Kauffman 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 nodeList 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)<bp[rest]>. The general case is BP3, which takes a crossing and splits it into A L +1/A R.
	[11] & [12] provide non-Mathematica 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.)

5. Data for various Curves, Loops, Bends, etc.

Most of these are 3D with negative underpass z coordinates, for clarity in the 2D rad→0 plots.

5.1. An arbitrary selection.

sq = {{{0, 1}, {1, 0}, {0, -1}, {-1, 0}, {0, 
              1}}};

ring = {{{0, 1, 0}, {1, 0, 1}, {0, -1, 0}, {-1, 
              0, -1}, {0, 1, 0}}};

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}}};

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}}};

simple2 =   
{{{-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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

unknot7 =   
{{{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}}};

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}}};

fig8a =   
{{{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}}};

Afig6o7 =  (*[4] 
            writhe example*) 
{{{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}}};

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}}};

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},   {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}}};

R3test2 = {{{0, 0, 0}, {1, 1, 1}, {0, 2, 1}, {-1, 1, 
              1}, {0, - .5,  .5}, {2.5,   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}  , {0, 0, 0}}};

circl3d = {{{0, 1, 0}, {1, 0, 1}, {0, -1, 0}, {-1, 
              0, -1}, {0, 1, 0}}};

p3d = {{{0,  .1,  .7}, { .5,  .5,  .1}, {1,  .1,  .9}, { .8,  .4, 
              1}, { .2,  .8,  .8}, {0,  .1,  .7}}};

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}}};

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}}};

hypercube4 =   
{{{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}}};

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}}};

5.2. Bends.

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}}};

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}}};

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}}};

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}, 
{-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}}};

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}}};

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}}};

hunters =  (*A1425a Hunter' 
            s bend*) 
{{{-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}}};

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}}};

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}}, 
{{-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}}};

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}}, 
{{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}}};

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}}
, {{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}}};

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}, 
{-1.2, 1.7, -1.5}, {- .3, 
              1.8, -1.1}, { .3,  .8, - .7}, { .4, -1, - .7}, { .4, -2, - .7}}, 
{{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}, 
{-1.6, 
              0, - .5}, {-1.2, 1.4, - .8}, {- .4, 
              1, - .9}, {- .2, 
              0, - .97}, {- .2, -1, -1}, {- .2, -2, -1}}};

waterKnotx (* -c,  
          A1022*)  = {{{-3, 0, 0}, {-1, 0, 0}, {0, 
              0,  .1}, {1, - .1,  .3}, {1.7, - .2, 
              1}, 
{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}}, 
{{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}}};

waterKnot (* C A496,  
          A1414*)  = {{{ .5,  .2, 
              0}, {0,  .2, - .1}, {- .9,  .1, - .3}, {-1.6, 
              0,  .8}, 
{-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}}, 
{{1.3,  .6, 0}, { .3,  .6, 
              0}, {- .7,  .45, - .2}, {-1.9, - .1, - .3}, {-2.4, - .4,  .8}, 
{-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}}};

\(\(zeppelinKnot (*"RL"\ Not\ in\ \(\(Ashley\)\(.\)\)\ *)  = {{{\(-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}, {\(- .8\), 4, 
              1}}
, {{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}}};\)\)

gord = {{{-4, 3/4, 0}, {-2, 3/4, 0}, {0, 1/2, -1/2}, {1, 
              0, -1}, {1, -1, -3/
                4}, 
{0, -5/4, 1}, {-1/2, 0, 
              0}, {0, 5/4, -1}, {1, 1, 3/4}, {1, 0, 
              1}, 
{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}, 
{0, -5/4, -1}, {1/2, 0, 
              0}, {0, 5/4, 1}, {-1, 1, -3/4}, {-1, 
              0, -1}, 
{0, -5/8, -1/
                2}, {2, -3/4, 0}, {3, -3/4, 
              0}}};  
bGord = {3, -1, 2, 3, -1, 2, 3, -1, 2, 3, -1, 2, 
          3, -1, 2, 3, -1, 2};

Show[curvs[ringBraid[bGord], chordno -> 1], V003, 
        BF];

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}}, 
{{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}}};

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}}, 
{{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}}};

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}}, 
{{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}}};

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}}, 
{{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}}};

5.3. Braids, Hitches, Weaves..

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}}, 
{{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}}};

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}}, 
{{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}}, 
{{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}}, 
{{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}}};

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}}};

weave436 = {
{{1, 0, 0}, {1, 1, 0.3}, {1, 
              2, -0.3}, {1, 3,  .3}, {1, 
              4, - .3}}, 
{{2, 0, 0}, {2, 
              1, -0.3}, {2, 2, 0.3}, {2, 3, - .3}, {2, 
              4,  .3}}, 
{{3, 0, 0}, {3, 1, 0.3}, {3, 
              2, -0.3}, {3, 3,  .3}, {3, 
              4, -0.3}}, 
{{4, 0, 0}, {4, 
              1, -0.3}, {4, 2, 0.3}, {4, 3, - .3}, {4, 4, 
              0.3}}, 

{{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}}, 
rad ->  .1, {{0, 2, 
              0}, {2, 4, 0}}, rad ->  .1, {{0, 1, 0}, {3, 4, 0}}, 
          rad ->  .1, {{0, 0, 0}, {4, 4, 0}}, 
          rad ->  .1, {{1, 0, 0}, {5, 4, 0}}, 
          rad ->  .1, {{2, 0, 0}, {5, 3, 0}}, 
          rad ->  .1, {{3, 0, 0}, {5, 2, 0}}};

weave77 = 
{{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 

{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}};

weave77a = 
{{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 

{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}, 
{{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}}};

hitch1 = {rad -> 0.3, 
          perimno -> 10, {{1, -1.5, 0.1}, {1, 1.2, 0.1}}, 
          rad -> 0.6, 
          perimno -> 
            20, {{-0.3, -1, 0.1}, {-0.3, 1.3, 0.1}}, 
          rad -> 
            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}}};

hitch2 =  (*clovehitch A1178*) 
{rad ->  .9, 
          perimno -> 
            8, {{0, -1, 0}, {0, 1, 
              0}}, 
rad ->  .07, 
{{-2, 0, 1}, {-1,  .02, 1}, {0,  .1, 
              1}, { .6,  .15,  .75}, 
{1,  .2, 
              0}, { .75,  .2, - .75}, {0,  .2, -1}, {- .75,  .2, - .75}, {-1,  .18, - .1}, {- .9,  .18,  .6}, 
{0, 0, 
              1.3}, 
{ .9, - .18,  .6}, {1, - .18, - .1}, { .75, - .2, - .75}, 
{0, - .2, -1}, {- .75, - .2, - .75}, {-1, - .2, 
              0}, {- .7, - .15,  .7}, {0, - .1, 
              1}, {1, - .02, 1}, {2, 0, 1}}};

Prusik =   {rad ->  .75, 
          perimno -> 
            12, {{0, 5, 0}, {0, 0, 0}}, 
{{-1.5, 
              5,  .5}, {-1.2, 3,  .55}, {- .5, 2.5,  .85}, {- .1, 
              2.45, 1}, { .65, 2.5,  .7}, {1, 2.7, - .1  }, {0, 
              2.85, -1}, {-1, 3, - .1}, {0, 3.15, 1}, {1, 
              3.3, - .1  }, {  0, 3.45, -1}, {- .75, 
              3.5, - .5}, {-1, 3.55,  .1}, {-1, 3.25, 
              1}, {-1.05, 2.4, 1.1  }, {-1.05, 1.5, 
              1}, {-1, 
              1,  .8}, {- .8,  .9, - .3}, {0,  .9, -1}, {1, 1.05, 
              0  }, {0, 1.2, 1}, {-1, 1.35, 0}, {0, 
              1.5, -1}, {1, 1.65, 0}, {0, 1.8, 1  }, {-1, 
              1.7,  .7}, {-1.5, 1,  .6}, {-1.5,  .5,  .6}, {-1.5, 
              0,  .6}}};

I have omitted the post in later hitches.

clovehitch =  (*A1178*) 
{{{-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}}};

Magnus =   {rad ->  .75, 
          perimno -> 
            12, {{0, 4, 0}, {0, 0, 0}}, 
{{-3, 
              2,  .5}, {-1.5, 2,  .55}, {- .5, 2.1,  .85}, {- .1, 
              2.2, 1}, { .75, 2.25,  .8}, {1, 
              2.3, - .1  }, {- .1, 2.4, -1}, {- .75, 
              2.5, - .5}, {-1, 2.55,  .1}, {-1, 2.25, 
              1}, {-1.05, 2, 1.1  }, {-1.05, 1.5, 1}, {-1, 
              1,  .8}, {- .8,  .9, - .3}, {0,  .9, -1}, {1, 1.05, 
              0  }, {0, 1.2, 1}, {-1, 1.35, 0}, {0, 
              1.5, -1}, {1, 1.65, 0}, {0, 1.8, 1}, {-1, 
              1.7,  .7  }, {-1.5, 
              1,  .6}, {-1.5,  .5,  .6}, {-1.5, 
              0,  .6}}};

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.

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}}};

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.

constrictor =  (*A1249. *) 
{{{-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}}};

The Boa (Collingwood 1996[10]) is a 4-loop constrictor that is tied in the same way, but starts with two loops.

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}}};

5.4. Dowker Notation test cases (NB uses nodeList, not lineList).

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}}};

Adamsfig29 = {{{-1, 8}, {2, 7}, {-3, 6}, {4, 9}, {-5, 
              10}, {6, 3}, {-7, 2}, {8, 1}, {-9, 4}, {10, 
              5}}};

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}}};

Adamsfig553 =   
{{{-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}}};

Adamsfig553a =   
{{{-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}}};

dowth[
      Adamsfig28]
  
dowth[-Adamsfig29]
ShowKnotfromPdata[KnotbyDT[%]];
dowth[Adamsfig212]
ShowKnotfromPdata[KnotbyDT[%]];
dowth[Adamsfig553]
ShowKnotfromPdata[KnotbyDT[%]];
dowth[Adamsfig553a]
ShowKnotfromPdata[KnotbyDT[%]];

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}}};

Show[curvs[4  dowtest, rad -> 0], 
        AspectRatio -> Automatic];
Show[curvs[2  dowtest, chordno -> 3], V003]; crosscurv[dowtest]; 
    dowth[]

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}}, 
{{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}}};

Show[curvs[4  dowtest2, rad -> 0], 
        AspectRatio -> Automatic];
Show[curvs[2  dowtest2, chordno -> 3], V003]; crosscurv[dowtest2]; 
    dowth[]

6. Named Knots k0c00n, Knot Graphs kg0c00n, and  Braids b0c00n. DataFile genKnots.

6.1. Nomenclature.

kcn is a lineList for the n'th knot with c crossings, c & n being left padded with zeroes to emulate [6]. bcn or bc[[n]] is a braid of the n'th knot with c crossings (though it may have more than c crossings). The Conway notation, for the corresponding knot, is often included as a comment. bcn#m is a composite knot.
	nodeList is the signed list of under/overcrossings created by crossings[]. 
	Most of the knots have starting points chosen so that knotGraph[name, par] makes the outside white when par 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. kgcn &  kgc[[n]] are knot graphs with "rectified" vertices, adjusted to be on a small rectangular grid.

6.2. Knots & Graphs with 3,4,5,6 vertices.

kg31 = 
        Graph[{{{1, 2}}, {{1, 3}}, {{2, 3}}}, {{{-1, 0}}, {{1, 0}}, {{0, 
                1}}}];

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}}}];

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}}};

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}}}];

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}}};

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}}};

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}}}];

Composite knots:-

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}}}];

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}}}];

6.3. Knots & Graphs with 7 vertices.

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}}};
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}}}];

k07001 = kn[7];

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}}]};

6.4. Knots & Graphs with 8 vertices.

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}}}],   
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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  , 
          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}}}]  };

k08001 = 
{{{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}}};

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}}};

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}}};

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}, 
{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}}};

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},   {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}}};

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}}}];

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}}};

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}}};

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}, 
{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}}};

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}}};

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}, 
{- .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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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}}};

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.*)

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}}};

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}}};

6.5. Knots & Graphs with 9 or more vertices.

Various graphs mentioned in [4] etc:-

k09023 = {{{0, 0, 1}, {1, 1, -1}, {2, 1, 0}, {2, 0, 
              1}, { .8, -1, -1}, 
{1, -2, 
              1}, {2.5, -2, 0}, {2, 0, -1}, {1, 1, 1}, {0, 1.3, 
              0}, {-1, 1, -1}, 
{-2, 0, 
              1}, {-2.5, -2, 
              0}, {-1, -2, -1}, {- .8, -1, 1}, {-2, 
              0, -1}, 
{-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}}};
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}}}];

Three more knots with the same shadow:-

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}, 
{-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}}};

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}, 
{-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}}};

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}, 
{-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}}};

k1000a = {{{2, 0, -1}, {4, 2, 1}, {5, 4, 1}, {3, 
            6, -1}, 
{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}}}];

k10129 and k88 have same HOMFLY  but different Kaufman polynomials.

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}}}];

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}}}];

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}}}];

The next two are the same knot (Perko) but have writhes of -8 and +10 [5,p25].

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}}}];

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}}}];

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}}}];

k11255 = {{{0, -2, -4}, {4, 4, 4}, {8, 0, -4}, {8, -8, 
              4}, 
{18, -8, -4}, {18, 0, 4}, {12, 
              0, -4}, {8, 0, 4}, {4, 4, -4}, 
{4, 
              8, 4}, {8, 12, 2}, {18, 12, -2}, {20, 6, -4}, {14, 6, 
              4}, 
{0, 8, -4}, {0, -4, 
              4}, {8, -6, -4}, {12, 0, 4}, {12, 
              6, -4}, 
{16, 8, 0}, {20, 4, 
              0}, {24, -4, -4}, {16, -8, 4}, {16, 
              0, -4}, 
{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}}}];

k11255 has same Kaufman and 1-variable Jones as k11257, but different HOMFLY (2-variable Jones0, Alexander, and Conway polynomials.

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}, 
{-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}, 
{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}}}];

pr = -1; crosscurv[k11255]
p11255 = nodeListToPword[nodeList]
KauffmanPolynomial[p11255]
SkeinPolynomial[0, p11255]
SkeinPolynomial[1, p11255]
SkeinPolynomial[-1, p11255]
SkeinPolynomial[-2, 
          p11255]

crosscurv[k11257]
p11257 = nodeListToPword[nodeList]
KauffmanPolynomial[p11257]
SkeinPolynomial[0, p11257]
SkeinPolynomial[1, p11257]
SkeinPolynomial[-1, p11257]
SkeinPolynomial[-2, 
          p11257]

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}}}];

6.6. Braids

b03001 = {1, 1, 1}  ;
b04001 = {2, -1, 
          2, -1}  ;
b05001 = {1, 1, 1, 1, 1}  ;

b06001 = {3, -2, 3, -1, 2, -1, 2}  ; 
    b06002 = {2, 2, 2, -1, 2, -1}  ; 
    b06003 = {2, 2, -1, -1, 2, -1}  ; 
    b06c33 = {2, 2, 2, -1, -1, -1};

Show[
        GraphicsArray[{{Show[curvs[ringBraid[b06001], chordno -> 3], DI, 
                V003], Show[curvs[ringBraid[b06002], chordno -> 3], DI, 
                V003]}, {Show[curvs[ringBraid[b06003], chordno -> 3], 
                DI, V003], 
              Show[curvs[ringBraid[b06c33], chordno -> 3], DI, 
                V003]}}]];

Some 7-braids for analysis:-

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}};

Show[
        GraphicsArray[
{{Show[
                curvs[braid[b07a[[1]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b07a[[2]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07a[[3]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07a[[4]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07a[[5]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07a[[6]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07a[[7]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07a[[8]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07a[[9]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07a[[10]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07a[[11]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07a[[12]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07a[[13]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07a[[14]]], rad ->  .2], DI, 
                V003]}}]];

Braids for 7-crossing knots, found by Alexander's technique. The longer ones may not be minimal.

b07 = {{1, 1, 1, 1, 1, 1, 1}  , {3, 3, 1, 2, 1, -3, 1, 2, 
            2}  , {2, 2, 1, 1, 1, 1, -2, 1}  , {3, 3, 
            2, -3, 1, -2, 1, 2, 2}  , {2, 2, 2, 2, 1, 
            1, -2, 1}  , {3, -2, 1, 1, 2, 3, 
            3, -1, -2}, {3, -2, 1, -2, 3, -2, -1, 
            3, -2}  , {3, 3, 3, 2, -1, 
            2, -1}  };

Show[
        GraphicsArray[
{{Show[
                curvs[braid[b07[[1]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b07[[2]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07[[3]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07[[4]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07[[5]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07[[6]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b07[[7]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b07[[8]]], rad ->  .2], DI, 
                V003]}}]];

Braids for 8-crossing knots, found by Alexander's technique. The longer ones are not guaranteed to be be minimal.

b08 = {{4, 1, -2, -3, 4, -1, -1, 
            2, -3, -2}  , {2, 2, 2, 2, 2, -1, 
            2, -1}  , {4, 4, -2, 
            3, -4, -2, -1, 2, 3, -1}  , {3, 3, 
            3, -2, -1, 2, 3, -1, -2}  , {2, 2, 
            2, -1, 2, 2, 2, -1}  , {2, 2, 2, -1, 
            2, 2, 1, 1}  , {2, 2, 2, 2, -1, 
            2, -1, -1}  , {3, 3, -1, -2, 3, 3, 
            1, -2, -3, -1, -1}  , {2, 2, 
            1, -2, -2, 1, -2, -1, 
            2, -1}  , {2, 2, 2, -1, -1, 2, 
            2, -1}  , 
{3, 3, 
            2, -3, 2, -1, 2, -1, 2}  , {4, 
            2, -3, 4, -1, 2, -3, -1}  , {3, 
            3, -1, -1, 2, -3, 2, -1, 2}  , {4, 
            4, -3, 4, 2, 3, -1, 2, 3, -1}  , {3, 
            1, 2, 2, 2, -3, 1, -2, 1}  , {2, 
            2, -1, 2, 2, -1, 2, -1}  , {2, 
            2, -1, -1, 2, -1, 
            2, -1}  , {2, -1, 2, -1, 2, -1, 
            2, -1}  , {2, 2, 1, -2, 1, 1, 2, 
            1}  , {2, 
            2, -1, -2, -2, 1, -2, -1}  , {2, 2, 1, 1, -2, 1, 
            2, -1}  };

Show[
        GraphicsArray[{{Show[curvs[braid[b08[[1]]], rad ->  .2], DI, 
                V003], Show[curvs[braid[b08[[2]]], rad ->  .2], DI, 
                V003], Show[curvs[braid[b08[[3]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b08[[4]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b08[[5]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b08[[6]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b08[[7]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b08[[8]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b08[[9]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b08[[10]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b08[[11]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b08[[12]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b08[[13]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b08[[14]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b08[[15]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b08[[16]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b08[[17]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b08[[18]]], rad ->  .2], DI, 
                V003]}, {Show[curvs[braid[b08[[19]]], rad ->  .2], 
                DI, V003], 
              Show[curvs[braid[b08[[20]]], rad ->  .2], DI, V003], 
              Show[curvs[braid[b08[[21]]], rad ->  .2], DI, 
                V003]}}]];

Dihedral Symmetry Braids:-

bD8 = {2, -1, 2, -1, 2, -1, 
        2, -1};   
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};

A few 9 node braids, mainly unidentified.