(************************************************************************)
(* *)
(* Braids.m *)
(* Draws braids *)
(* *)
(* version 1.3 *)
(* Joe Christy 5/6/90 *)
(* *)
(************************************************************************)
(*
* Copyright (c) 1990, Joe Christy
* Department of Mathematics and Computer Science
* Emory University
* Atlanta, GA 30322
*
* email address: joe@mathcs.emory.edu
*
* This software is copyrighted as noted above. It may be freely copied,
* modified, and redistributed, provided that the copyright notice is
* preserved on all copies.
*
* There is no warranty or other guarantee of fitness for this software,
* it is provided solely "as is". Bug reports or fixes may be sent
* to the authors, who may or may not act on them as they desire.
*
* You may not include this software in a program or other software product
* without supplying the source, or without informing the end-user that the
* source is available for no extra charge.
*
* If you modify this software, you should include a notice giving the
* name of the person performing the modification, the date of modification,
* and the reason for such modification.
*)
(*
* REVISION HISTORY
*
* version 1.0 4/15/90
* version 1.1 4/17/90
* added Ribbons, made open braids and plats run from top to bottom.
* version 1.2 5/3/90
* now handles framings of closed braids.
* version 1.3 5/6/90
* through the magic of GrayLevel, crossings now visible in
* Curve Style.
*
*)

(*
* TO DO
*
* Faster
*
*)

BeginPackage["Braids`",
"SymmetricGroup`",
"BraidGroup`"]

(* Messages *)

OpenBraid::usage =
"OpenBraid[b, (options)] constructs a Graphic3D of b as an open braid.
It takes a single option, Style (Automatic) which tells it whether to draw
curves, ribbons, or tubes."

Options[OpenBraid] = {Style -> Automatic}

ClosedBraid::usage =
"ClosedBraid[b, (options)] constructs a Graphic3D of b as a closed braid.
It takes the following options:\n
Style (Automatic) which tells it whether to draw curves, ribbons, or tubes.\n
Canon (1) which tells it what the convention for the canonical framing is.\n
Framing (Automatic) which twists the framing by some number of full twists relative
to the canonical framing"

Options[ClosedBraid] = {Style -> Automatic, Canon->1, Framing->Automatic}

Plat::usage =
"Plat[b, (options)] constructs a Graphic3D of b as a plat.
It takes a single option, Style (Automatic) which tells it whether to draw
curves, ribbons, or tubes."

Options[Plat] = {Style -> Automatic}

Components::usage =
"Components[b] returns the number of components of the closed braid b."

Style::usage =
"Style is an option to the braid drawing functions.\n
The default is to draw curves, which is fast, but the crossings are invisible.\n
Style -> Ribbon draws ribbons, which are slower, but show the crossings.\n
Style -> Tube draws tubes, which are very slow."

Ribbon::usage =
"Style -> Ribbon draws ribbons, which are slow, but show the crossings."

Tube::usage =
"Style -> Tube draws tubes, which are very slow."

Canon::usage =
"Canon (1) is an option to ClosedBraid which specifies the canonical framing.\n
Canon -> 0 specifies the physicist's framing, determined by the normal to
the projection plane.\n
Canon -> 1 specifies the topologist's framing, determined by the boundary
of the Seifert surface."

Framing::usage =
"Framing (Automatic) is an option to ClosedBraid which specifies a framing
by giving a list of the numbers of full twists around each component
relative to the canonical framing."

Style::bogus =
"`` is not a valid Style for ``!"

Begin["`Private`"] (* begin the private context *)

(******************************************************************)
(* The functions below, based on Henry Cejtin's Tube package, *)
(* take care of drawing tubular neighborhoods. *)
(******************************************************************)
(* Added Torsion and generally splificated JPC 4/15/90 *)
(******************************************************************)

(*
*
* Given a (symbolic) 3-space curve, a radius and a range over which to
* vary an independent variable, return a 3-D graphics object which
* represents a tubular neighborhood of the curve of the given radius.
* Note, the radius may be depend on the independent variable.
* the curve.
* Note, the curve must be differentiable (by Mathematica) and the
* derivative vector must not vanish.
* parity, either 1 or -1, is a kludge to adjust the framing to the
* physicists vertical framing.
* Several options are understood by tblrNbhd:
* CurvePoints the number of points to sample along the curve.
* TubePoints the number of points to sample around the disks
* forming the tube.
* Twist an angle by which to twist the mesh on the surface
* (defaulting to 0, or no twisting).
* Torsion an angle by which to twist the mesh along the curve
* (defaulting to 0, or no twisting).
* Closed if True, (the default) then the curve is assumed to
* be closed (i.e., end where it starts).
*
*)

Options[tblrNbhd] = {
CurvePoints -> 50,
TubePoints -> 8,
Twist -> 0,
Torsion -> 0,
Closed -> True
}

tblrNbhd[curve_, radius_, {var_, low_, high_}, parity_, opts___] :=
Block[{
CurvePoints,
TubePoints,
Twist,
Torsion,
Closed,
angles,
cpoints,
vpoints,
tpoints,
tube,
mesh,
theta,
delta,
i,
j,
res,
rot,
rotm
},
{CurvePoints, TubePoints, Twist, Torsion, Closed} =
{CurvePoints, TubePoints, Twist, Torsion, Closed}
/. Options[{opts}]
/. Options[tblrNbhd];
cpoints = Table[ (* points along curve *)
curve,
{var, low, high, (high-low)/CurvePoints}
] //N;
If[Closed, (* match ends of curve *)
cpoints[[-1]] = cpoints[[1]]
];
tpoints = Table[ (* tangent vectors to curve *)
Release[
D[curve, var]
],
{var, low, high, (high-low)/CurvePoints}
] //N;
vpoints = tpoints = Map[ (* unit tangent vectors to curve *)
Unitize,
tpoints
] // N;
rot = Angle[ (* between initial and final tangents *)
vpoints[[1]],
vpoints[[-1]]
] //N;
rotm = {{Cos[rot],Sin[rot],0},
{-Sin[rot],Cos[rot],0},
{0,0,1}};
(* rotation in x-z plane by angle between initial and final tangents *)
tpoints = CTrans[ (* translates of initial normal *)
tpoints,
Cross[Perp[First[tpoints]],First[tpoints]]
] //N;
tpoints *= Table[ (* scaled normal field *)
N[radius],
{var, low, high, (high-low)/CurvePoints}
];
angles = Table[ (* constant twist field *)
N[Twist],
{var, low, high, (high-low)/CurvePoints}
];
If[Closed,
delta = Angle[ (* angle between initial and final normals *)
tpoints[[1, 1]],
tpoints[[-1, 1]]
] //N,
delta = parity * Angle[ (* angle between initial and final normals after *)
tpoints[[1, 1]], (* turning of tangent is taken into account *)
rotm . tpoints[[-1, 1]]
] //N
];
If[delta != 0, (* compensate for torsion of curve *)
angles -= Table[
theta,
{theta, 0, delta, delta/CurvePoints}
]
];
angles += Table[ (* add external torsion *)
N[Torsion*dt],
{dt, 0, 1, 1/CurvePoints}
];
tpoints = Map[ (* twist normal field *)
Twist2,
Transpose[{
angles,
tpoints
}]
];
If[Closed, (* force normals to match at ends *)
tpoints[[-1]] = tpoints[[1]]
];
tube = Table[
{Cos[var], Sin[var]},
{var, 0, 2 Pi, 2 Pi / TubePoints}
] //N;
mesh = Re[Table[ (* Somehow these vectors can get to be complex! *)
cpoints[[i]] +
tube[[j]] . tpoints[[i]],
{i, Length[cpoints]},
{j, Length[tube]}
]];
res = ToGraphics[mesh];
If[! Closed,
res = Graphics3D[{
Polygon[First[mesh]],
res[[1]],
Polygon[Last[mesh]]
}]
];
res
]

(*
* Given a list of unit 3-dimensional vectors, and another vector,
* return a list of pairs of vectors such that corresponding elements
* of the original list and the result list form an orthonormal,
* right-handed coordinate system.
* This is done by assuming that the list represents tangents to a curve,
* and parallely translating the orthonormal component of the given vector
* along the curve.
*)
CTrans[tlist_, vec_] :=
Block[{
v = vec
},
Map[
{
v = Unitize[v - (v . #) #],
Cross[#, v]
}&,
tlist
]
]

(*
* Given a 2-dimensional mesh of points on a surface, produce a
* Graphics3D object which contains the polygons forming the
* surface.
*)
ToGraphics[mesh_] :=
Block[{
i,
j
},
Graphics3D[
Table[
Polygon[{
mesh[[i, j]],
mesh[[i, j+1]],
mesh[[i+1, j+1]],
mesh[[i+1, j]]
}],
{i, Length[mesh] - 1},
{j, Length[mesh[[1]]] - 1}
]
]
]

(*
* Given a non-zero vector, return any vector not parallel to it.
* This is done by returning the coordinate vector for the coordinate
* with minimal absolute value in the original vector.
*)
Perp[u_] :=
Block[{
coord = 1,
value = Abs[First[u]],
i
},
Do[
If[Abs[u[[i]]] <= value,
value = Abs[u[[i]]];
coord = i
],
{i, 2, Length[u]}
];
Table[
If[i == coord,
1,
0
],
{i, Length[u]}
]
]

(*
* Given an angle and two orthogonal vectors, return the result of rotating
* the vectors through the angle.
*)
Twist2[{angle_, vecs_}] :=
Block[{
cos = Cos[angle]//N,
sin = Sin[angle]//N
},
{{cos, sin},
{-sin, cos}} . vecs
];

(*
* Given a (non-zero) vector, return a vector that points in the same
* direction but is of unit length.
*)
Unitize[vec_] := vec / Sqrt[vec . vec]

(*
* Given two vectors (in 3-space), return their cross product.
*)
Cross[u_, v_] :=
Det[{
{{1,0,0}, {0,1,0}, {0,0,1}},
u,
v
}]

(*
* Given two (non-zero) vectors, return the angle between them.
*)
Angle[u_, v_] := ArcCos[Unitize[u] . Unitize[v]]

(**************************)
(* Some constants we need *)
(**************************)

twopi = N[2*Pi];

(***********************************************)
(* These functions take care of drawing curves *)
(* with the GrayLevel proportional to height. *)
(***********************************************)

gly[{{x1_,y1_,z1_},{x2_,y2_,z2_}}]:=
GrayLevel[2 (y1+y2)/3 + 0.4]

glz[{{x1_,y1_,z1_},{x2_,y2_,z2_}}]:=
GrayLevel[0.4 - 2 (z1+z2)/3]

(*********************************************************************)
(* The functions dc* handle the construction of a single crossing. *)
(* They are called repeatedly by the top level functions. *)
(*********************************************************************)

(***********************)
(* open braided curves *)
(***********************)
(*
* dcOC[m, sn, cn]
* draws the sn-th strand passing through the elementary
* braid m at level cn. Open Curve.
*)

dco[m_,sn_,cn_]:=
Table[{m + 1/2 - Cos[Pi Sin[t]^2]/2,
0.3 Sin[Pi Sin[t]^2],
1 - 2 t/Pi -cn},
{t, 0, Pi/2, Pi/40}] /; sn == m

dco[m_,sn_,cn_]:=
Table[{m + 1/2 - Cos[Pi Sin[t]^2 + Pi]/2,
0.3 Sin[Pi Sin[t]^2 + Pi],
1 - 2 t/Pi -cn},
{t, 0, Pi/2, Pi/40}] /; sn == m + 1

dco[m_,sn_,cn_]:=
Table[{-m + 1/2 - Cos[Pi Sin[t]^2]/2,
-0.3 Sin[Pi Sin[t]^2],
1 - 2 t/Pi -cn},
{t, 0, Pi/2, Pi/40}] /; sn == -m

dco[m_,sn_,cn_]:=
Table[{-m + 1/2 - Cos[Pi Sin[t]^2 + Pi]/2,
-0.3 Sin[Pi Sin[t]^2 + Pi],
1 - 2 t/Pi -cn},
{t, 0, Pi/2, Pi/40}] /; sn == -m + 1

dco[m_,sn_,cn_]:=
Table[{sn, 0, 1 - 2 t/Pi -cn}, {t, 0, Pi/2, Pi/2}]

dcOC[m_,sn_,cn_]:=
Block[{pq3=
Transpose[{
Drop[dco[m,sn,cn],-1],
Drop[RotateLeft[dco[m,sn,cn]],-1]
}]
},
Graphics3D[Flatten[Transpose[{Map[gly,pq3],Map[Line,pq3]}],1]]
]

(*************************)
(* closed braided curves *)
(*************************)
(*
* dcCC[m, sn, cn, c]
* draws the sn-th strand passing through the
* elementary braid m at level cn out of c total crossings. Closed Curve.
*)

dcc[m_,sn_,cn_,c_]:=
Table[{(m + 1/2 - Cos[Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(m + 1/2 - Cos[Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
0.3 Sin[Pi Sin[t]^2]},
{t, 0, Pi/2, Pi/40}] /; sn == m

dcc[m_,sn_,cn_,c_]:=
Table[{(m + 1/2 - Cos[Pi + Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(m + 1/2 - Cos[Pi + Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
0.3 Sin[Pi + Pi Sin[t]^2]},
{t, 0, Pi/2, Pi/40}] /; sn == m + 1

dcc[m_,sn_,cn_,c_]:=
Table[{(-m + 1/2 -Cos[Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(-m + 1/2 -Cos[Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
-0.3 Sin[Pi Sin[t]^2]},
{t, 0, Pi/2, Pi/40}] /; sn == -m

dcc[m_,sn_,cn_,c_]:=
Table[{(-m + 1/2 -Cos[Pi + Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(-m + 1/2 -Cos[Pi + Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
-0.3 Sin[Pi + Pi Sin[t]^2]},
{t, 0, Pi/2, Pi/40}] /; sn == -m + 1

dcc[m_,sn_,cn_,c_]:=
Table[{sn Cos[2(cn - 1)Pi/c + 4 t/c], sn Sin[2(cn - 1)Pi/c + 4 t/c], 0},
{t, 0, Pi/2, Pi/20}]

dcCC[m_,sn_,cn_,c_]:=
Block[{pq3=
Transpose[{
Drop[dcc[m,sn,cn,c],-1],
Drop[RotateLeft[dcc[m,sn,cn,c]],-1]
}]
},
Graphics3D[Flatten[Transpose[{Map[glz,pq3],Map[Line,pq3]}],1]]
]

(**********************)
(* open braided tubes *)
(**********************)
(*
* dcOTN[m, sn, cn, tpn]
* draws the sn-th strand passing through the
* elementary braid m at level cn.
* Open Tubular Neighborhood with tpn points meridionally.
*)

dcOTN[m_,sn_,cn_,tpn_]:=
tblrNbhd[{m + 1/2 - Cos[Pi Sin[t]^2]/2,
0.3 Sin[Pi Sin[t]^2],
1 - 2 t/Pi -cn},
0.2,
{t, 0, Pi/2},
1,
CurvePoints->15, TubePoints->tpn, Closed->False] /; sn == m

dcOTN[m_,sn_,cn_,tpn_]:=
tblrNbhd[{m + 1/2 - Cos[Pi Sin[t]^2 + Pi]/2,
0.3 Sin[Pi Sin[t]^2 + Pi],
1 - 2 t/Pi -cn},
0.2,
{t, 0, Pi/2},
1,
CurvePoints->15, TubePoints->tpn, Closed->False] /; sn == m + 1

dcOTN[m_,sn_,cn_,tpn_]:=
tblrNbhd[{-m + 1/2 - Cos[Pi Sin[t]^2]/2,
-0.3 Sin[Pi Sin[t]^2],
1 - 2 t/Pi -cn},
0.2,
{t, 0, Pi/2},
-1,
CurvePoints->15, TubePoints->tpn, Closed->False] /; sn == -m

dcOTN[m_,sn_,cn_,tpn_]:=
tblrNbhd[{-m + 1/2 - Cos[Pi Sin[t]^2 + Pi]/2,
-0.3 Sin[Pi Sin[t]^2 + Pi],
1 - 2 t/Pi -cn},
0.2,
{t, 0, Pi/2},
-1,
CurvePoints->15, TubePoints->tpn, Closed->False] /; sn == -m + 1

dcOTN[m_,sn_,cn_,tpn_]:=
tblrNbhd[{sn, 0, 1 - 2 t/Pi -cn}, 0.2, {t, 0, Pi/2}, 1,
CurvePoints->2, TubePoints->tpn, Closed->False]

(************************)
(* closed braided tubes *)
(************************)
(*
* dcCTN[m, sn, cn, c, tpn, tw, skew, screw]
* draws the sn-th strand passing through the
* elementary braid m at level cn out of c total crossings.
* Closed Tubular Neighborhood with tpn points meridionally.
* tw is an amount by which to twist the framing in a crossing.
* skew is the amount to rotate the framing,
* and screw is the amount by which to twist it.
*)

dcCTN[m_,sn_,cn_,c_,tpn_,tw_,skew_,screw_]:=
tblrNbhd[{(m + 1/2 -Cos[Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(m + 1/2 -Cos[Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
0.3 Sin[Pi Sin[t]^2]},
0.2,
{t, 0, Pi/2},
1,
CurvePoints->15, TubePoints->tpn, Closed->False,
Twist->N[twopi*skew], Torsion->N[twopi*(screw-tw)]] /; sn == m

dcCTN[m_,sn_,cn_,c_,tpn_,tw_,skew_,screw_]:=
tblrNbhd[{(m + 1/2 -Cos[Pi + Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(m + 1/2 -Cos[Pi + Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
0.3 Sin[Pi + Pi Sin[t]^2]},
0.2,
{t, 0, Pi/2},
1,
CurvePoints->15, TubePoints->tpn, Closed->False,
Twist->N[twopi*skew], Torsion->N[twopi*(screw-tw)]] /; sn == m + 1

dcCTN[m_,sn_,cn_,c_,tpn_,tw_,skew_,screw_]:=
tblrNbhd[{(-m + 1/2 -Cos[Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(-m + 1/2 -Cos[Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
-0.3 Sin[Pi Sin[t]^2]},
0.2,
{t, 0, Pi/2},
-1,
CurvePoints->15, TubePoints->tpn, Closed->False,
Twist->N[twopi*skew], Torsion->N[twopi*(screw+tw)]] /; sn == -m

dcCTN[m_,sn_,cn_,c_,tpn_,tw_,skew_,screw_]:=
tblrNbhd[{(-m + 1/2 -Cos[Pi + Pi Sin[t]^2]/2) Cos[2(cn - 1)Pi/c + 4 t/c],
(-m + 1/2 -Cos[Pi + Pi Sin[t]^2]/2) Sin[2(cn - 1)Pi/c + 4 t/c],
-0.3 Sin[Pi + Pi Sin[t]^2]},
0.2,
{t, 0, Pi/2},
-1,
CurvePoints->15, TubePoints->tpn, Closed->False,
Twist->N[twopi*skew], Torsion->N[twopi*(screw+tw)]] /; sn == -m + 1

dcCTN[m_,sn_,cn_,c_,tpn_,tw_,skew_,screw_]:=
tblrNbhd[{sn Cos[2(cn - 1)Pi/c + 4 t/c], sn Sin[2(cn - 1)Pi/c + 4 t/c], 0},
0.2,
{t, 0, Pi/2},
1,
CurvePoints->10, TubePoints->tpn, Closed->False,
Twist->N[twopi*skew], Torsion->N[twopi*screw]]

(**********************************************************************)
(* The *Cap* functions handle the construction of the caps of a plat. *)
(* They are called by Plat. *)
(**********************************************************************)

topCapC[st_] :=
Table[
Graphics3D[{GrayLevel[0.4],
Line[Table[
{Cos[theta]/2 + 2 m - 1/2,
0,
Sin[theta]/2},
{theta,0,Pi,Pi/15}
]]
}],
{m,1,st/2}
]

bottomCapC[st_,xn_] :=
Table[
Graphics3D[{GrayLevel[0.4],
Line[Table[
{Cos[theta]/2 + 2 m - 1/2,
0,
-xn - Sin[theta]/2},
{theta,0,Pi,Pi/15}
]]
}],
{m,1,st/2}
]

topCapTN[st_,tpn_] :=
Table[
tblrNbhd[
{Cos[theta]/2 + 2 m - 1/2,
0,
Sin[theta]/2},
0.2,
{theta, 0, Pi},
0,
CurvePoints->10, TubePoints->tpn, Closed->False
],
{m,1,st/2}
]

bottomCapTN[st_,xn_,tpn_] :=
Table[
tblrNbhd[
{Cos[theta]/2 + 2 m - 1/2,
0,
-xn - Sin[theta]/2},
0.2,
{theta, 0, Pi},
0,
CurvePoints->10, TubePoints->tpn, Closed->False
],
{m,1,st/2}
]

(**********************************************)
(* The top level functions. *)
(**********************************************)

Components[b_] :=
CycleLength[BraidToPermutation[b]] /; BraidQ[b] || Message[Braid::bogus, b]

OpenBraid[b_, options___] :=
Block[{form = Style /. {options} /. Options[OpenBraid]},
Switch[form,
Automatic,
Table[ dcOC[b[[1]][[cn]], sn, cn],
{sn, 1, b[[2]]}, {cn, 1, CrossingNumber[b]}
],
Ribbon,
Table[ dcOTN[b[[1]][[cn]], sn, cn, 2],
{sn, 1, b[[2]]}, {cn, 1, CrossingNumber[b]}
],
Tube,
Table[ dcOTN[b[[1]][[cn]], sn, cn, 8],
{sn, 1, b[[2]]}, {cn, 1, CrossingNumber[b]}
],
_,
Message[Style::bogus, form, "OpenBraid"]
]
] /; BraidQ[b] || Message[Braid::bogus, b]

ClosedBraid[b_, options___] :=
Block[{form, cf, ff, ps, nx, nc, cl, pb},
{form, cf, ff}={Style, Canon, Framing} /. {options} /. Options[ClosedBraid];
nc = Components[b];
cl = CycleLengths[BraidToPermutation[b]];
cb = ToCycles[BraidToPermutation[b]];
If[ ff == Automatic, ff = Table[0, {nc}]];
If[ Length[ff] < nc,
ff = Join[ff, Table[0, {nc - Length[ff]}]]];
nx = CrossingNumber[b];
ps = Table[ BraidToPermutation[{Take[ b[[1]], n], b[[2]]}],
{n, 0, nx - 1}];
Switch[form,
Automatic,
Table[
dcCC[b[[1]][[cn]], sn, cn, CrossingNumber[b]],
{sn, 1, b[[2]]}, {cn, 1, CrossingNumber[b]}
],
Ribbon,
Table[
dcCTN[ b[[1, k]], ps[[ k, cb[[i, j]] ]], k, nx, 2, cf/2,
(j-1)*ff[[i]]/cl[[i]] + (k-1)*ff[[i]]/(nx*cl[[i]]),
ff[[i]]/(nx*cl[[i]])
],
{i,1,nc},{j,1,cl[[i]]},{k,1,nx}
],
Tube,
Table[
dcCTN[ b[[1, k]], ps[[ k, cb[[i, j]] ]], k, nx, 8, cf/2,
(j-1)*ff[[i]]/cl[[i]] + (k-1)*ff[[i]]/(nx*cl[[i]]),
ff[[i]]/(nx*cl[[i]])
],
{i,1,nc},{j,1,cl[[i]]},{k,1,nx}
],
_,
Message[Style::bogus, form, "ClosedBraid"]
]
] /; BraidQ[b] || Message[Braid::bogus, b]

Plat[b_, options___] :=
Block[{form = Style /. {options} /. Options[Plat],
s = 2 Ceiling[ b[[2]]/2 ]},
Switch[form,
Automatic,
{
topCapC[s],
Table[ dcOC[b[[1]][[cn]], sn, cn],
{sn, 1, s}, {cn, 1, CrossingNumber[b]}
],
bottomCapC[s, CrossingNumber[b]]
},
Ribbon,
{
topCapTN[s, 2],
Table[ dcOTN[b[[1]][[cn]], sn, cn, 2],
{sn, 1, s}, {cn, 1, CrossingNumber[b]}
],
bottomCapTN[s, CrossingNumber[b], 2]
},
Tube,
{
topCapTN[s, 8],
Table[ dcOTN[b[[1]][[cn]], sn, cn, 8],
{sn, 1, s}, {cn, 1, CrossingNumber[b]}
],
bottomCapTN[s, CrossingNumber[b], 8]
},
_,
Message[Style::bogus, form, "Plat"]
]
] /; BraidQ[b] || Message[Braid::bogus, b]

End[] (* end the private context *)
EndPackage[] (* end the package context *)