Planar Diagrams to Braids

October 2014, Hilary Hunt
This program takes planar link diagrams as represented on katlas and finds a braid representative for them.
To run the program, make sure that you have installed the KnotTheory` package and run everything.

<<KnotTheory`

(* Given a planar diagram, this returns a braid *)
diagramToBraid[diagram_PD]:=Module[
{newDiagram,
elements1,
elements2,
i=0},
newDiagram=FixedPoint[reduce[#]&,writeSD[diagram]];
While[i<Length[newDiagram],
i++;
If[Count[#[[5]]&/@newDiagram,i]>1,
newDiagram=miniFold[newDiagram,i];
newDiagram=FixedPoint[reduce[#]&,newDiagram];
i=0;
];
];
newDiagram=fold[newDiagram];
Return[read[newDiagram]];
];

(* Write a Seifert diagram using the given PD *)
writeSD[pd_PD]:=Module[
{nestedTree=nest[pd],
circles,
sd=SeifertDiagram[],
i},
circles=flattenTree[nestedTree];
For[i=1,i<Length[circles]+1,i++,sd=Join[sd,SeifertDiagram[SeifertCircle[i,Sign[circles[[i]][[1]]],findBands[circles[[i]],pd,nestedTree],
If[i==Length[circles],{},findInside[circles[[i]],nestedTree,circles[[i+1]]]],findOutside[circles[[i]],nestedTree]]]];
];
Return[sd];
];

(* This assumes that the first two circles listed have opposite orientations *)
(* It also assumes that circles do not have more than one directly nested circle *)
reduce[diagram_SeifertDiagram]:=Module[
{newDiagram=diagram,
arc},
arc=findReducingArc[newDiagram];
If[arc≠{},
arc=arc[[1]];
newDiagram=resolve[diagram,arc];
checkDiagram[newDiagram];
(* Uncomment for testing *)
(*Print["diagram: ",diagram,"arc: ",arc,"nd: ",newDiagram];*)
];

Return[newDiagram];
];

(* Loops through the circles in a diagram to find a reducing arc *)
findReducingArc[diagram_SeifertDiagram]:=Module[
{arc,
i},
For[i=1,i<Length[diagram]+1,i++,
arc=findReducingArc2[diagram,i];
If[arc≠{},Return[{arc[[1]]}]];
];
(* No reducing arc *)
Return[{}];
];

(* Loops through the bands in a circle to look for a reducing arc *)findReducingArc2[diagram_SeifertDiagram,circle_Integer]:=Module[
{circle1=diagram[[circle]],
circle1num,
circle2,circle2num,
band1,
band2,
listofbands,
joiningcircle,
i},
circle1num=circle1[[1]];
listofbands=circle1[[3]];
For[i=1,i<Length[listofbands]+1,i++,
band1=listofbands[[i]];
joiningcircle=findCircle[diagram,band1[[3]]];
band2=nextband[joiningcircle,band1[[1]]];
circle2num=band2[[3]];
circle2=findCircle[diagram,circle2num];
If[circle1[[5]]==circle2[[5]],
If[checkReducingArc[circle1,circle2,band1,band2]==1,
Return[{ReducingArc[circle1,circle2,band1,band2]}];
];
];
];
Return[{}];
];

(* Checks that a reducing arc is between two different, similarly oriented circles *)checkReducingArc[circle1_SeifertCircle,circle2_SeifertCircle,band1_SeifertBand,band2_SeifertBand]:=Module[
{},
If[circle1==circle2,Return[0]];
If[band1==band2,Return[0]];
If[circle1[[2]]≠circle2[[2]],
Print["Different orientations:",circle1,",",circle2,"\n"];
Abort[];
];
Return[1];
];

(* Resolve two circles connected by a reducing arc into nested circles and produce a new Seifert Diagram *)
resolve[diagram_SeifertDiagram,arc_ReducingArc]:=Module[
{circle1,circle2,band1,band2,
newCircle1,newCircle2,
name1,orientation,bands1,inside1,outside,
name2,bands2,inside2,
newDiagram=diagram,
newBands1,
bandnum=numberOfBands[diagram]+1},

{circle1,circle2,band1,band2}=List@@arc;
{name1,orientation,bands1,inside1,outside}=List@@circle1;
{name2,orientation,bands2,inside2,outside}=List@@circle2;

If[band1[[3]]==outside,
newBands1=Join[{SeifertBand[bandnum++,in,name2,1]},RotateRight[reorder[bands1,band1],1],{SeifertBand[bandnum++,in,name2,-1]},reorder[bands2,band2]],
newBands1=Join[{SeifertBand[bandnum++,in,name2,1]},reorder[bands1,band1],{SeifertBand[bandnum++,in,name2,-1]},RotateRight[reorder[bands2,band2],1]]];


newCircle1=SeifertCircle[
name1,
orientation,
newBands1,
Join[inside1,{name2},inside2],
outside];

newCircle2=SeifertCircle[
name2,
orientation,
{SeifertBand[bandnum-2,out,name1,1],SeifertBand[bandnum-1,out,name1,-1]},
{},
name1];

checkCircle[newCircle1];
checkCircle[newCircle2];
newDiagram=changeBands[bands2,name1,newDiagram];
newDiagram=changeCircles[inside2,name1,newDiagram];
newDiagram=replaceCircles[newDiagram,newCircle1,newCircle2];
checkDiagram[newDiagram];
Return[newDiagram];
];

(* Rewrites a circle containing two unnested circles so that it envelopes the other part of the diagram and the three circles are now outermost *)
miniFold[diagram_SeifertDiagram,outerCircle_Integer]:=Module[
{newDiagram=diagram,
names,
circle,
circlePos,
circles,
outerCircles,
nextCircle},
circles=Select[List@@diagram,#[[5]]==outerCircle&];
circles=ReplacePart[#,5->0]&/@circles;
(* Invert the circle enclosing two unnested cirles *)
{circle,nextCircle}=invertCircle[outerCircle,diagram,0];
circles=Join[circles,{circle}];
(* Rewrite all outer circles so that they are now inside the inverted circle*)
outerCircles=Select[List@@diagram,#[[5]]==0&];
outerCircles=Complement[outerCircles,Select[outerCircles,Count[#[[4]],outerCircle]>0&]];
outerCircles=ReplacePart[#,5->outerCircle]&/@outerCircles;
circles=Join[circles,outerCircles];

While[nextCircle≠0,
{circle,nextCircle}=invertCircle[nextCircle,diagram,circle[[1]]];
circles=Join[circles,{circle}];
];
(* Replace circles in diagram *)
(* NOTE: Would be faster to just write a new diagram with circles *)
names=First[#]&/@newDiagram;
circlePos=(Position[names,#[[1]]][[1]])&/@circles;
circles=Partition[Riffle[circles,circlePos],2];
newDiagram=ReplacePart[newDiagram,#[[2]]->#[[1]]&/@circles];

(* Uncomment for testing *)
(*Print["mF: ",diagram,outerCircle,"Return: ",newDiagram];*)
Return[newDiagram];
];


(* Inverts a circle and returns the newly inverted circle with the circle outside it *)
invertCircle[circleNum_Integer,diagram_SeifertDiagram,outside_Integer]:=Module[
{circle=findCircle[diagram,circleNum],
nextCircle,
circlePos,
inPos, outPos},
nextCircle=circle[[5]];
circle[[2]]=-circle[[2]];
circle[[3]]=Reverse[circle[[3]]];
inPos=Position[circle[[3]],in];
outPos=Position[circle[[3]],out];
circle[[3]]=ReplacePart[circle[[3]],#->out&/@inPos];
circle[[3]]=ReplacePart[circle[[3]],#->in&/@outPos];
circle[[4]]=Complement[listCircles[diagram],circle[[4]],{circle[[1]]}];
circle[[5]]=outside;
Return[{circle,nextCircle}];
];


(* Given two sets of nested circles, returns one combined set of nested circles*)
fold[diagram_SeifertDiagram]:=Module[
{newDiagram=diagram,
circle1,
circle,nextCircle,
names, circlePos,
circles},
If[Count[#[[5]]&/@newDiagram,0]>1,
{circle1,nextCircle}=Select[List@@diagram,#[[5]]==0&];
(* Put circle1 inside circle2 *)
circle1[[5]]=nextCircle[[1]];
circles={circle1};
nextCircle={nextCircle[[1]]};
(* Recursion on the outer circles to turn them 'inside out' *)
While[Flatten[nextCircle]≠{},
nextCircle={findCircle[diagram,nextCircle[[1]]]};
{circle,nextCircle}=invert[nextCircle[[1]],diagram];
circles=Join[circles,{circle}];
];

(*Rewrite diagram *)
names=First[#]&/@newDiagram;
circlePos=(Position[names,#[[1]]][[1]])&/@circles;
circles=Partition[Riffle[circles,circlePos],2];
newDiagram=ReplacePart[newDiagram,#[[2]]->#[[1]]&/@circles];

(* Uncomment for testing *)
(*Print["fold: ",diagram," into ",newDiagram];*)
];
Return[newDiagram];
];

(* A recursive function that inverts a circle so that anything outside is now inside it and vice versa *)
invert[circle_SeifertCircle,diagram_SeifertDiagram]:=Module[
{newDiagram=diagram,
nextCirclePos=Position[circle[[3]],in],
nextCircle={},
newCircle=circle,
inPos,outPos},
If[nextCirclePos≠{},
nextCircle=Extract[circle[[3]],Most[nextCirclePos[[1]]]][[3]];
newCircle[[5]]=nextCircle,
newCircle[[5]]=0;
];
newCircle[[2]]=-circle[[2]];
newCircle[[3]]=Reverse[circle[[3]]];
inPos=Position[newCircle[[3]],in];
outPos=Position[newCircle[[3]],out];
newCircle[[3]]=ReplacePart[newCircle[[3]],#->out&/@inPos];
newCircle[[3]]=ReplacePart[newCircle[[3]],#->in&/@outPos];
newCircle[[4]]=Complement[listCircles[diagram],newCircle[[4]],{newCircle[[1]]}];
Return[{newCircle,{nextCircle}}];
];

(* Given a diagram, returns a list of the circle names *)
listCircles[diagram_SeifertDiagram]:=Module[
{},
Part[#,1]&/@List@@diagram
];

(* Takes a Seifert diagram consisting of a single stack of nested circles and finds its representative braid *)
read[diagram_SeifertDiagram]:=Module[
{outerCircle,
bands,
braid,
depth=1},
{outerCircle}=Select[List@@diagram,#[[5]]==0&];
bands=outerCircle[[3]];
braid=bandsToBraid[#,diagram,depth]&/@bands;
braid=Flatten[braid];
(*braid=Reverse[braid];*)
braid=BR[Max[Abs[braid]]+1,braid];
Return[Flatten[braid]];
];

(* The iterative part of read. Given a band, a Seifert diagram and a depth, it will record the braid as its depth and check whether the next braid is in or out.
If in, it will recurse, if out, it returns the current braid *)bandsToBraid[band_SeifertBand,diagram_SeifertDiagram,depth_Integer]:=Module[
{braid={depth*band[[4]]},
nextCircle,
bands,
i},
nextCircle=findCircle[diagram,band[[3]]];
bands=nextCircle[[3]];
bands=reorder[bands,band];
For[i=1,i<Length[bands],i++,
If[bands[[i]][[2]]===in,
braid=Join[braid,bandsToBraid[bands[[i]],diagram,depth+1]],

Return[braid]];
];
];

(* Counts the number of bands in a Seifert Diagram *)
numberOfBands[diagram_SeifertDiagram]:=Module[
{number=0,
i},
For[i=1,i<Length[diagram]+1,i++,
number=number+Length[diagram[[i]][[3]]];
];
number=number/2
];

(* Given a circle and a band, returns the next band clockwise on the circle *)
nextband[circle_SeifertCircle,band_Integer]:=Module[
{bandlist=circle[[3]],
bandpos,
newband={},
direction,
i},
bandpos=findBand[bandlist,band];
direction=bandlist[[bandpos]][[2]];
i=bandpos-1;
While[i>0&&newband=={},
If[bandlist[[i]][[2]]===direction,
newband=bandlist[[i]]];
i--;
];
i=Length[bandlist];
While[i>bandpos&&newband=={},
If[bandlist[[i]][[2]]===direction,
newband=bandlist[[i]]];
i--;
];

Return[newband];
];

(* Given a list of bands and the name of a band, returns the position of the band in the list *)
findBand[list:{___SeifertBand},band_Integer]:=Module[
{i},
For[i=1,i<Length[list]+1,i++,
If[list[[i]][[1]]==band,Return[i]];
];
];

(* Looks for any problems with a Seifert Circle *)
checkCircle[circle_SeifertCircle]:=Module[
{},
If[circle[[1]]==0,
Print["0 circle"];
Abort[];
];
If[Length[circle]≠5,Abort[];];
];

(* Go through the diagram and redirect any bands previously pointing to the now nested circle to point to circle *)changeBands[bands:{___SeifertBand},circle_Integer,diagram_SeifertDiagram]:=Module[
{i,j,k,
otherbands,
newDiagram=diagram},
For[j=1,j<Length[diagram]+1,j++,
If[diagram[[j]][[1]]≠circle,
otherbands=diagram[[j]][[3]];
For[k=1,k<Length[otherbands]+1,k++,
For[i=1,i<Length[bands]+1,i++,
If[otherbands[[k]][[1]]==bands[[i]][[1]],
otherbands[[k]][[3]]=circle;
];
   ];
];
newDiagram[[j]][[3]]=otherbands;
];];
Return[newDiagram];
];

(* Go through the diagram and redirect inner circles to point to the new outer circle *)changeCircles[circles:{___Integer},circle_Integer,diagram_SeifertDiagram]:=Module[
{i,j,
newDiagram=diagram},
For[ i=1,i<Length[circles]+1,i++,
For[j=1,j<Length[newDiagram]+1,j++,
If[newDiagram[[j]][[1]]==circles[[i]],
newDiagram[[j]][[5]]=circle];
];];
Return[newDiagram];
];

(* Given a list of bands and a single band, returns the list with the single band at its head *)
reorder[bands:{___SeifertBand}, band_SeifertBand]:=Module[
{bandnum,
newBands},
bandnum=findBand[bands,band[[1]]];
newBands=RotateLeft[bands, bandnum];
Return[newBands];
];

(* Replaces two circles within the diagram with new circles *)replaceCircles[diagram_SeifertDiagram,circle1_SeifertCircle,circle2_SeifertCircle]:=Module[
{newDiagram=diagram,
circle1pos=findCirclePos[diagram,circle1[[1]]],
circle2pos=findCirclePos[diagram,circle2[[1]]],
i},

newDiagram[[circle1pos]]=circle1;
newDiagram[[circle2pos]]=circle2;
checkDiagram[newDiagram];
Return[newDiagram];
];

(* Performs checks on the diagram to ensure there are no obvious problems with it *)
checkDiagram[diagram_SeifertDiagram]:=Module[
{i,j,k,
circle,
bands,band,
count=0,
bandnum=numberOfBands[diagram]+1},
(* Check that every band appears exactly twice *)
For[i=1,i<bandnum,i++,
For[j=1,j<Length[diagram]+1,j++,
circle=diagram[[j]];
bands=circle[[3]];
For[k=1,k<Length[bands]+1,k++,
band=bands[[k]];
If[band[[1]]==i,count++];
];
];
If[count≠2,
Print["Problem with bands"];
Print[i,diagram];
Abort[];];
count=0;
];

(* Check that every circle appears only once*)
For[i=1,i<Length[diagram],i++,
For[j=i+1,j<Length[diagram]+1,j++,
If[diagram[[i]][[1]]==diagram[[j]][[1]],
Print["Multiple circles",diagram[[i]][[1]]];
Abort[];
];
];];

(* Check that the 'outside' part of every circle is present *)
circle=Select[diagram,#[[5]]=={}&];
If[Length[circle]>0,
Print["Outside missing"];
Abort[];
];
(* Check that every band in a circle is connected to it *)
(* Check that every band connects to a circle in the diagram *)
];

(* Finds a circle in the diagram and returns the position of the circle within the list of circles *)
findCirclePos[diagram_SeifertDiagram,circle_Integer]:=Module[
{i},
For[i=1,i<Length[diagram]+1,i++,
If[diagram[[i]][[1]]==circle,Return[i]];
];
Print["'findCirclePos' Error: Circle not found"];
Abort[];
];
(* Given a diagram and the name of a circle, returns the circle *)findCircle[diagram_SeifertDiagram,circle_Integer]:=Module[
{i},
For[i=1,i<Length[diagram]+1,i++,
If[diagram[[i]][[1]]==circle,
Return[diagram[[i]]]];
];
Print["Circle:",circle," does not exist in diagram",diagram];
Abort[];
];

(* Rewrites a PD so that all the crossing orientations are labelled and the order of each crossing is [in,out,out,in] *)
orientCrossings[pd_PD]:=Module[
{link=Times@@pd},
posCrossings=X[a_,b_,c_,d_]:>Xp[a,b,c,d];
negCrossings1=X[a_,b_,c_,d_]X[e_,f_,g_,a_]:>X[a,b,c,d]Xm[f,g,a,e];
negCrossings2=X[a_,b_,c_,d_]X[e_,f_,b_,g_]:>Xm[b,c,d,a]X[e,f,b,g];
negCrossings3=X[a_,b_,c_,d_]Xm[e_,b_,f_,g_]:>Xm[b,c,d,a]Xm[e,b,f,g];
negCrossings4=X[a_,b_,c_,d_]Xm[e_,f_,g_,d_]:>Xm[b,c,d,a]Xm[e,f,g,d];
negCrossings5=X[a_,b_,c_,d_]Xm[e_,f_,b_,g_]:>Xm[b,c,d,a]Xm[e,f,b,g];
negCrossings6=X[a_,b_,c_,d_]:>isNegative[X[a,b,c,d]];
link=link//.negCrossings6;
link=link//.negCrossings1;
link=link//.negCrossings2;
link=link//.negCrossings3;
link=link//.negCrossings4;
(*link=link//.negCrossings5;*)
link=link/.posCrossings;
checkOrientCrossings[productToPD[link]];
Return[productToPD[link]];
];
(* Checks the sign of a crossing and, if it is negative marks it *)
isNegative[crossing_]:=Module[
{a,b,c,d},
{a,b,c,d}=List@@crossing;
If[d==b+1,
Return[Xm[b,c,d,a]],
Return[crossing];
];
];

(* Double check that orientCrossings has done what it should *)
checkOrientCrossings[pd_PD]:=Module[
{i,j},
For[i=1,i<Length[pd],i++,
For[j=i+1,j<Length[pd]+1,j++,
If[pd[[i]][[1]]==pd[[j]][[1]]
||pd[[i]][[1]]==pd[[j]][[4]]
||pd[[i]][[4]]==pd[[j]][[1]]
||pd[[i]][[4]]==pd[[j]][[4]],
Print["Arc in ",pd[[i]]," and ",pd[[j]]," enters 2 crossings"];
];
If[pd[[i]][[2]]==pd[[j]][[2]]
||pd[[i]][[2]]==pd[[j]][[3]]
||pd[[i]][[3]]==pd[[j]][[2]]
||pd[[i]][[3]]==pd[[j]][[3]],
Print["Arc in ",pd[[i]]," and ",pd[[j]]," exits 2 crossings"];
];];];
];

(* Rewrites a product of crossings as a PD *)
productToPD[product_]:=Module[
{pd=product},
posPD=Xp[a_,b_,c_,d_]:>PD[Xp[a,b,c,d]];
negPD=Xm[a_,b_,c_,d_]:>PD[Xm[a,b,c,d]];
PDPD=PD[a__]PD[b__]:>PD[a,b];
pd=pd//.posPD;
pd=pd//.negPD;
pd=pd//.PDPD;
Return[pd];
];

(* Finds the Seifert Circles created from a PD *)
makeCircles[pd_PD]:=Module[
{circles,
ruleXmP,ruleXpP,
rulePC,
link=Times@@orientCrossings[pd]},

ruleXmP=Xm[a_,b_,c_,d_]:> P[a,{},b]P[c,{},d];
ruleXpP=Xp[a_,b_,c_,d_]:> P[a,{},b]P[c,{},d];
P/:P[a_,inside1:{___Integer},b_]P[b_,inside2:{___Integer},c_]:=P[a,Join[inside1,{b},inside2],c];
P/:P[e_,inside_,e_]:=P[Join[{e},inside]];
P/:P[list:{___Integer}]:=P[{list}];
P/:P[list1_]P[list2_]:=P[Join[list1,list2]];
circles=link/.ruleXmP;
circles=circles/.ruleXpP//Simplify;
Return[circles[[1]]];
];

(* Returns the two crossings a given strand intersects *)
findCrossing[strand_Integer,pd_PD]:=Module[
{position,
cPos,
crossings},
position=Position[pd,strand];
cPos=Transpose[position][[1]];
crossings=Extract[pd,Map[{#}&,cPos]];
Return[crossings];
];

(* Returns the circle the strand comes from *)
findCircle[strand_Integer,circles_]:=Module[
{pos},
pos=Position[Abs[circles],Abs[strand]];
If[pos=={},
Return[{}],
pos=pos[[1]];
Return[circles[[pos[[1]]]]];
];
];

(* Returns a tree of the nesting graph of a PD *)
nest[inputPD_PD]:=Module[
{pd=orientCrossings[inputPD],
circles,
tree,
crossings,
adjacentCrossings={1},
prevCrossings={},
strand,
i,j=0,k,l},
circles={makeCircles[pd]};
tree={circles[[1]][[1]]};
circles=Insert[circles,{circles[[1]][[1]]},2];
circles=Delete[circles,{1,1}];
While[circles[[1]]≠{}&&adjacentCrossings≠{},
adjacentCrossings={};
For[l=1,l≤Length[circles[[2]]],l++,
For[k=1,k≤Length[circles[[2]][[l]]],k++,
adjacentCrossings=Union[findCrossing[Abs[circles[[2]][[l]][[k]]],pd],adjacentCrossings];
];];
adjacentCrossings=Complement[adjacentCrossings,prevCrossings];
For[i=1,i≤Length[adjacentCrossings],i++,
If[Complement[List@@adjacentCrossings[[i]],Abs[Flatten[tree]]]≠{},
{tree,circles}=addCircle[tree,adjacentCrossings[[i]],circles];
];];
prevCrossings=Union[prevCrossings,adjacentCrossings];
];

tree=joinInsides[tree];
If[circles[[1]]≠{},
Print["WARNING: Nontrivial disjoint union of links"]];
Return[tree];
];
(* Fixes the tree structure to remove unnecessary branches created in nest *)
joinInsides[treeO_]:=Module[
{tree=treeO,
i},
For[i=2,i≤Length[tree],i++,
tree[[i]]=joinInsides[tree[[i]]];
If[Depth[tree[[i-1]]]>2&&Depth[tree[[i]]]>2,
tree[[i-1]]=Join[tree[[i-1]],tree[[i]]];
tree=Delete[tree,i];
i=i-1];
];
Return[tree];
];

(* Adds a new circle to the tree (nesting graph) once an adjacent crossing has been determined *)
addCircle[treeO_,crossingX_,circles_]:=Module[
{strand,
circle,
tree=treeO,
currentCircle,
newCircles=circles,
pos,
crossing=List@@crossingX,
sign},
strand=Complement[crossing,Abs[Flatten[tree]]];
circle=findCircle[strand[[1]],circles[[1]]];
(* Check the orientation of the other circle in the crossing *)
(* Negative orientation will mean that the circle is outside if it is to the right, positive orientation mean outside is to the left *)
currentCircle=Complement[crossing,strand];
currentCircle=findCircle[currentCircle[[1]],circles[[2]]];
If[Sign[currentCircle[[1]]]==1,
sign=0,
sign=2];
If[crossing[[1+sign]]==strand[[1]]||crossing[[1+sign]]==strand[[2]]||crossing[[2+sign]]==strand[[1]]||crossing[[2+sign]]==strand[[2]],
(* New circle to the right (inside) of crossing *)
pos=Position[tree,currentCircle];
tree=Delete[tree,pos];
tree=Insert[tree,{-(sign-1)*circle},pos];
tree=Insert[tree,currentCircle,pos];
newCircles=Delete[circles,Position[circles,circle]];
newCircles=Insert[newCircles,-(sign-1)*circle,{2,1}],
(* New circle to the left (outside) of crossing *)
pos=Position[tree,findCircle[crossing[[1+sign]],circles[[2]]]];
tree=Insert[tree,(sign-1)*circle,pos];
newCircles=Delete[circles,Position[circles,circle]];
newCircles=Insert[newCircles,(sign-1)*circle,{2,1}];
];
Return[{tree,newCircles}];
];

(* Names a circle in the tree based on its position *)
circleNum[circle_,tree_]:=Module[
{number,
pos,
i,j},
pos=Position[flattenTree[Abs[tree]],Abs[circle]];
If[pos≠{},
Return[pos[[1]][[1]]],
Return[{}];
];
];

(* Flattens the nested circles into a list of the circles *)
flattenTree[tree_]:=Module[
{circles={},
i},
For[i=1,i<Length[tree]+1,i++,
If[Depth[tree[[i]]]>2,
circles=Join[circles,flattenTree[tree[[i]]]],
circles=Join[circles,{tree[[i]]}]];
];
Return[circles];
];

(* Finds the circles nested within the circle given *)
findInside[circle_,tree_,nextCircle_]:=Module[
{pos,
posNext,
posLength,inside={}},
pos=Position[tree,circle][[1]];
posLength=Length[pos];
pos[[posLength]]=pos[[posLength]]+1;
If[Position[tree,nextCircle][[1]]==Join[pos,{1}],
Return[Inside[Extract[tree,pos],tree]],
Return[{}]];
];

(* Returns a list of nested circles *)
Inside[circles_,tree_]:=Module[
{i,
inside={}},
For[i=1,i<Length[circles]+1,i++,
If[Depth[circles[[i]]]<3,
inside=Join[inside,{circleNum[circles[[i]],tree]}],
inside=Join[inside,Inside[circles[[i]],tree]]];
];
Return[inside];
];

(* Finds the circle in which the given circle is nested or returns 0 if it is not nested *)
findOutside[circle_,tree_]:=Module[
{pos,
outside},
pos=Position[tree,circle][[1]];
If[Length[pos]==1,
Return[0],
pos=Delete[pos,Length[pos]];
pos[[Length[pos]]]=pos[[Length[pos]]]-1;
outside=circleNum[Extract[tree,pos],tree];
Return[outside]];
];

(* Reorder the crossings of a circle so that they correspond to the order of the arcs of the circle *)
orderCrossings[circle_,crossings_]:=Module[
{orderedCrossings={crossings[[1]]},
remainingCrossings=Rest[crossings],
pos,
nextCrossing,
side,
count=1},
While[remainingCrossings≠{},
side=Intersection[Abs[circle],List@@orderedCrossings[[count]]];
If[side[[1]]==orderedCrossings[[count]][[1]]||side[[1]]==orderedCrossings[[count]][[2]],
(* right *)
side=2,
(* left *)
side=3];
pos=Position[remainingCrossings,orderedCrossings[[count]][[side]]];
nextCrossing=Complement[Extract[remainingCrossings,Most[#]&/@pos],orderedCrossings];
orderedCrossings=Join[orderedCrossings,nextCrossing];
remainingCrossings=Complement[remainingCrossings,orderedCrossings];
count++;
];
If[Sign[circle[[1]]]==-1,
orderedCrossings=Reverse[orderedCrossings]];
Return[orderedCrossings]
];

(* Returns a list of all bands attached to a circle *)
findBands[circle_,pdO_,tree_]:=Module[
{pd=orientCrossings[pdO],
crossings={},
bands={},
i},
crossings=Union[Flatten[(findCrossing[Abs[#],pd])&/@circle]];
crossings = orderCrossings[circle,crossings]; 
bands=(SeifertBand[bandNum[#,pd],inOrOut[#,circle,tree],otherCircle[#,circle,tree],sign[#]])&/@crossings;
Return[bands];
];
(* Returns the name of a band *)
bandNum[crossing_,pd_]:=Module[
{pos},
pos=Position[pd,crossing];
Return[pos[[1]][[1]]];
];

(* Determines the direction of a band *)
inOrOut[crossing_,circle_,tree_]:=Module[
{circle2,
pos1,
pos2},
circle2=Complement[List@@crossing,Abs[circle]];
pos2=Position[Abs[tree],circle2[[1]]][[1]];
pos1=Position[tree,circle][[1]];
If[Length[pos2]-1>Length[pos1],
Return[in],
Return[out]];
];

(* Finds the ci*)
otherCircle[crossing_,circle_,tree_]:=Module[
{otherCircle},
otherCircle=Complement[List@@crossing,Abs[circle]];
otherCircle=findCircle[otherCircle[[1]],flattenTree[tree]];
Return[circleNum[otherCircle,tree]];
];
sign[crossing_]:=Module[
{},
rule={Xm[a__]:>-1,Xp[b__]:>1};
Return[crossing/.rule];
];