Quelle  knot-comp-bound.gi   Sprache: unbekannt

# KnotComplement
################################################################################
############ Input: an arc presentation ########################################
################################################################################
########### Output: a regular CW-complex representing the complement of ########
################### the input link #############################################
################################################################################
InstallGlobalFunction(
    KnotComplement,
    function(arg...)
    local
        rand, D, len, signless, PuncturedDisk,
        P, grid, loop_correction, PuncturedTube, i;

    if Length(arg)>1
        then
        rand:=true;
        Print("Random 2-cell selection is enabled.\n");
    else
        rand:=false;
    fi;

    D:=arg[1];
    len:=Length(D);
    signless:=List(D,x->[AbsInt(x[1]),AbsInt(x[2])]);

    PuncturedDisk:=function(D)
        local
            grid, i, IsIntersection,
            CornerConfiguration, bound,
            bigGrid, GridFill, j, tick,
            hslice, vslice, k, 0c, Orient,
            path, FaceTrace, traced_bound, cgrid;

        grid:=List([1..len],x->List([1..len],y->0));
        for i in [1..len]
            do
            grid[len-i+1][D[i][1]]:=1;
            grid[len-i+1][D[i][2]]:=1;
        od;

        IsIntersection:=function(i,j)

            if grid[i][j]=0
                then
                if 1 in grid[i]{[1..j]}
                    then
                    if 1 in grid[i]{[j..len]}
                        then
                        if 1 in List([1..i],x->grid[x][j])
                            then
                            if 1 in List([i..len],x->grid[x][j])
                                then
                                return true;
                            fi;
                        fi;
                    fi;
                fi;
            fi;

        return false;
        end;

        CornerConfiguration:=function(i,j);

            if grid[i][j]=1
                then
                if Size(Positions(grid[i]{[j..len]},1))=2
                    then
                    if Size(Positions(List([i..len],x->grid[x][j]),1))=2
                        then # Corner type 1, i.e : __
                        return 1; #                |
                    elif Size(Positions(List([1..i],x->grid[x][j]),1))=2
                        then # Corner type 3, i.e :
                        return 3; #                |__
                    fi;
                elif Size(Positions(grid[i]{[1..j]},1))=2
                    then
                    if Size(Positions(List([i..len],x->grid[x][j]),1))=2
                        then # Corner type 2, i.e : __
                        return 2; #                   |
                    elif Size(Positions(List([1..i],x->grid[x][j]),1))=2
                        then # Corner type 4, i.e :
                        return 4; #                 __|
                    fi;
                fi;
            fi;

            return 0;
        end;

        bound:=[[],[],[],[],[]];
        bigGrid:=List([1..2*len],x->List([1..2*len],y->0));

        GridFill:=function(c,i,j);
# places an * at each point where a 0-cell is to be added to bigGrid
            if c=1 or c=4
                then
                bigGrid[(2*i)-1][(2*j)-1]:='*';
                bigGrid[2*i][2*j]:='*';
            elif c=2 or c=3
                then
                bigGrid[(2*i)-1][2*j]:='*';
                bigGrid[2*i][(2*j)-1]:='*';
            fi;
        end;

        for i in [1..len]
            do # loop through bigGrid and add temporary *s
            for j in [1..len]
                do
                if IsIntersection(i,j)
                    then # four 0-cells at an intersection
                    bigGrid[(2*i)-1][(2*j)-1]:='*';
                    bigGrid[(2*i)-1][2*j]:='*';
                    bigGrid[2*i][(2*j)-1]:='*';
                    bigGrid[2*i][2*j]:='*';
                elif grid[i][j]=1
                    then # two 0-cells at the endpoints of each horizontal bar
                    GridFill(CornerConfiguration(i,j),i,j);
                fi;
            od;
        od;

        tick:=2;
        for i in [1..2*len]
            do # number the 0-cells row-by-row
            for j in [1..2*len]
                do
                if bigGrid[i][j]='*'
                    then
                    bigGrid[i][j]:=tick;
                    tick:=tick+1;
                fi;
            od;
        od;

        for i in [1..2*len]
            do # connect all 0-cells that lie in the same
            hslice:=[]; # horizontal/vertical 'slice'
            vslice:=[];
            for j in [1..2*len]
                do
                if not bigGrid[i][j]=0
                    then
                    Add(hslice,bigGrid[i][j]);
                fi;
                if not bigGrid[j][i]=0
                    then
                    Add(vslice,bigGrid[j][i]);
                fi;
            od;
            for k in [1..Length(hslice)]
                do
                if Length(hslice)>k
                    then
                    Add(bound[2],[2,hslice[k],hslice[k+1]]);
                fi;
            od;
            for k in [1..Length(vslice)]
                do
                if Length(vslice)>k
                    then
                    Add(bound[2],[2,vslice[k],vslice[k+1]]);
                fi;
            od;
        od;

        for i in [1..len]
            do # add the looping 1-cells to the 1-skeleton
            for j in [1..len]
                do
                if CornerConfiguration(i,j) in [1,4]
                    then
                    Add(bound[2],[
                        2,
                        bigGrid[(2*i)-1][(2*j)-1],
                        bigGrid[2*i][2*j]
                        ]
                    );
                    Add(bound[2],[
                        2,
                        bigGrid[(2*i)-1][(2*j)-1],
                        bigGrid[2*i][2*j]
                        ]
                    );
                elif CornerConfiguration(i,j) in [2,3]
                    then
                    Add(bound[2],[
                        2,
                        bigGrid[(2*i)-1][2*j],
                        bigGrid[2*i][(2*j)-1]
                        ]
                    );
                    Add(bound[2],[
                        2,
                        bigGrid[(2*i)-1][2*j],
                        bigGrid[2*i][(2*j)-1]
                        ]
                    );
                fi;
            od;
        od;

        0c:=Maximum(List(bigGrid,x->Maximum(x)));
        for i in [1..0c+1]
            do
            Add(bound[1],[1,0]);
        od;

        Add(bound[2],[2,1,2]); # connect the central component to the
        Add(bound[2],[2,Length(bound[1])-1,Length(bound[1])]); # circumference
        Add(bound[2],[2,1,Length(bound[1])]); # of the disk
        Add(bound[2],[2,1,Length(bound[1])]);

        bigGrid:=FrameArray(bigGrid);
        bigGrid[1][2]:=1; # Adds the first and last 0-cells to bigGrid
        bigGrid[Length(bigGrid)][Length(bigGrid[1])-1]:=0c+1;

        Orient:=function(bound)
# traces the 1-skeleton in a clockwise walk to yield the 2-cells
            local 
                unchosen, neighbours, i, j,
                Clockwise;

            unchosen:=List(ShallowCopy(bound[2]),x->[x[2],x[3]]);
            neighbours:=List(ShallowCopy(bound[1]),x->[]);

            for i in [1..Length(bound[1])]
                do
                for j in [1..Length(unchosen)]
                    do
                    if i in unchosen[j]
                        then
                        Add(neighbours[i],j);
                    fi;
                od;
            od;

            Clockwise:=function(neighbours)
                local # orders clockwise the neighbours of each 0-cell
                    oriented, first0, last0,
                    i, j, x, k, l, posi, posx;

                oriented:=List(neighbours,x->List([1..12],y->"pass"));
                first0:=SortedList(neighbours[1]);
                last0:=SortedList(neighbours[Length(neighbours)]);

                oriented[1][7]:=first0[1];
                oriented[1][6]:=first0[3];
                oriented[1][8]:=first0[2];
            # these two orderings are always fixed;
            # they correspond to the circumferential edges
                oriented[Length(oriented)][1]:=last0[1]; 
                oriented[Length(oriented)][2]:=last0[3];
                oriented[Length(oriented)][12]:=last0[2];

                for i in [2..Length(neighbours)-1]
                    do # excludes the 1st and last 0-cells
                    for j in [1..Length(neighbours[i])]
                        do # x is a neighbouring 0-cell to i
                        x:=bound[2][neighbours[i][j]];
                        x:=Filtered(x{[2,3]},y->y<>i)[1];
                        for k in [1..Length(bigGrid)]
                            do
                            for l in [1..Length(bigGrid[1])]
                                do
                                if i=bigGrid[k][l]
                                    then
                                    posi:=[k,l];
                                fi;
                                if x=bigGrid[k][l]
                                    then
                                    posx:=[k,l];
                                fi;
                            od;
                        od;
                        # below are the checks for orientation,
                        # there are 12 in total (two for each diagonal):
                        # _\\|//_
                        #  //|\\
                        # ! ugly code warning !
                        if posi[1]>posx[1]
                            then
                            if posi[2]=posx[2]
                                then
                                oriented[i][1]:=neighbours[i][j];
                            elif posi[2]<posx[2]
                                then
                                if oriented[i][2]="pass"
                                    then # *always assigns the upper loop first*
                                    oriented[i][2]:=neighbours[i][j];
                                else
                                    oriented[i][3]:=neighbours[i][j];
                                fi;
                            elif posi[2]>posx[2]
                                then
                                if oriented[i][12]="pass"
                                    then
                                    oriented[i][12]:=neighbours[i][j];
                                else
                                    oriented[i][11]:=neighbours[i][j];
                                fi;
                            fi;
                        elif posi[1]=posx[1]
                            then
                            if posi[2]<posx[2]
                                then
                                oriented[i][4]:=neighbours[i][j];
                            elif posi[2]>posx[2]
                                then
                                oriented[i][10]:=neighbours[i][j];
                            fi;
                        elif posi[1]<posx[1]
                            then
                            if posi[2]=posx[2]
                                then
                                oriented[i][7]:=neighbours[i][j];
                            elif posi[2]<posx[2]
                                then
                                if oriented[i][5]="pass"
                                    then
                                    oriented[i][5]:=neighbours[i][j];
                                else
                                    oriented[i][6]:=neighbours[i][j];
                                fi;
                            elif posi[2]>posx[2]
                                then
                                if oriented[i][9]="pass"
                                    then
                                    oriented[i][9]:=neighbours[i][j];
                                else
                                    oriented[i][8]:=neighbours[i][j];
                                fi;
                            fi;
                        fi;
                    od;
                od;
                
                return oriented;
            end;

            return Clockwise(neighbours);
        end;

        path:=Orient(bound);
        # this is an ordered list of the neighbours of each 1-cell

        FaceTrace:=function(path)
            local
                unselectedEdges, sourceORtarget, faceloops,
                x, ClockwiseTurn, IsLoop, loop_correction, edge,
                2nd_loop, 2cell, sORt, ori, e1, e0, i;

            unselectedEdges:=List([1..Length(bound[2])-2]);
            unselectedEdges:=Concatenation(unselectedEdges,unselectedEdges);
            Add(unselectedEdges,Length(bound[2])-1);
            Add(unselectedEdges,Length(bound[2]));
# list of two of each edge except for the circumferential edges

            ClockwiseTurn:=function(p,e)
# inputs the orientation list of a node and the number of an edge in that list,
# outputs the next edge after a clockwise turn
                local
                    f;
                
                f:=(Position(p,e) mod 12)+1;
                while p[f]="pass"
                    do
                    f:=(f mod 12)+1;
                od;
                
                return p[f];
            end;

            ############ ADDED 15/10/19 ############
            IsLoop:=function(n)

                if Length(Positions(bound[2],bound[2][n]))=2 then
                    return true;
                else
                    return false;
                fi;

            end;

            loop_correction:=List(bound[2],x->0);
            ########################################

            sourceORtarget:=List([1..Length(bound[2])],y->[3,2]);
            x:=1;
            while unselectedEdges<>[]
                do # main loop, locates all 2-cells
                if rand
                    then
                    x:=Random([1..Length(bound[2])]); # select a random edge
                fi;
                while (not x in unselectedEdges) and (not e1 in unselectedEdges)
                    do # reselect edge if it already has two
                    if rand # 2-cells in its coboundary
                        then
                        x:=Random([1..Length(bound[2])]);
                    else
                        x:=x+1;
                    fi;
                od;

                2cell:=[x]; # the 2-cell begins with just x in its boundary
                if rand
                    then
                    sORt:=Random([2,3]);
                else
                    sORt:=sourceORtarget[x][Length(sourceORtarget[x])];
                    Unbind(sourceORtarget[x][Length(sourceORtarget[x])]);
                fi;
                ori:=path[bound[2][x][sORt]]; # the orientation of x's target
                e0:=bound[2][x][sORt];
                e1:=ClockwiseTurn(ori,x); # next edge to travel along
                while e1<>x
                    do
                    Add(2cell,e1);
                    e0:=Filtered(bound[2][e1]{[2,3]},y->y<>e0)[1]; # e1's target
                    ori:=path[e0];
                    e1:=ClockwiseTurn(ori,e1);
                od;
                Add(2cell,Length(2cell),1);
                if (not Set(2cell) in List(bound[3],x->Set(x)))
                    then
                    for i in Filtered(2cell{[2..Length(2cell)]},
                    y->y in unselectedEdges)
                        do
                        Unbind(unselectedEdges[Position(unselectedEdges,i)]);
                    od;
                    Add(bound[3],2cell);
                fi;

                ############ ADDED 15/10/19 ############
                # orders any loops that are present in the 2cell by the order
                # in which they were selected (doesn't include redundant 2cells
                # which are filtered out after the main while loop)
                if 2cell[1]<>2 then
                    faceloops:=Filtered(2cell{[2..Length(2cell)]},IsLoop);
                    if faceloops<>[] then
                        for edge in faceloops do
                            if loop_correction[edge]=0 then
                                loop_correction[edge]:=1;
                                2nd_loop:=Filtered(
                                    Positions(
                                        bound[2],
                                        bound[2][edge]
                                    ),
                                    y->y<>edge
                                )[1];
                                loop_correction[2nd_loop]:=2;
                            fi;
                        od;
                    fi;
                fi;
                ########################################
                        
            od;

            bound[3]:=Filtered(bound[3],y->y[1]<>2);
            return [bound,loop_correction];
        end;

        cgrid:=grid*0; # this is needed at the very end when
        for i in [1..Length(grid)] # patching the tubes together
            do
            for j in [1..Length(grid)]
                do
                cgrid[i][j]:=CornerConfiguration(i,j);
            od;
        od;

        traced_bound:=FaceTrace(path);

        return [traced_bound[1],cgrid,traced_bound[2]];
    end;

    P:=PuncturedDisk(D);
    grid:=P[2];
    loop_correction:=P[3];
    P:=P[1];

    PuncturedTube:=function(bound)
        local
            l0, l1, l2, DuplicateDisk,
            JoinDisks, Patch, prepatch,
            postpatch, Cap;

        l0:=Length(bound[1]);
        l1:=Length(bound[2]);
        l2:=Length(bound[3]);

        DuplicateDisk:=function(bound)
            local # creates a disjoint copy of the punctured
                i, edges2, faces2; # disk and concatenates the two

            for i in [1..l0]
                do
                Add(bound[1],[1,0]);
            od;

            edges2:=List(ShallowCopy(bound[2]),x->[2,x[2]+l0,x[3]+l0]);
            bound[2]:=Concatenation(bound[2],edges2);

            faces2:=List(ShallowCopy(bound[3]),
            x->Concatenation([x[1]],x{[2..Length(x)]}+l1));
            bound[3]:=Concatenation(bound[3],faces2);

            return bound;
        end;

        bound:=DuplicateDisk(bound);
        loop_correction:=Concatenation(loop_correction,loop_correction);

        JoinDisks:=function(bound)
# patch together the two disks via 1-cells, 2-cells & 3-cells
# mathematically speaking, form the space P x I where I is the unit interval
            local
                i, x, y, 3cell;

            for i in [1..l0]
                do # connect the 2 disks by 1-cells
                Add(bound[2],[2,i,l0+i]);
            od;

            for i in [1..l1]
                do # for each base 1-cell, form a 2-cell
                x:=bound[2][i][2];
                y:=bound[2][i][3];
                Add(bound[3],[4,i,l1+i,(l1*2)+x,(l1*2)+y]);
            od;

            for i in [1..l2]
                do # form a 3-cell from each 2-cell in the base disk
                x:=List(bound[3][i]{[2..Length(bound[3][i])]},y->y+(2*l2));
                3cell:=Concatenation([i,l2+i],x);
                Add(3cell,Length(3cell),1);
                Add(bound[4],3cell);
            od;

            return bound;
        end;

        bound:=JoinDisks(bound);

        prepatch:=Length(bound[3]);
        postpatch:=0;

        Patch:=function(bound)
            local # close the tubes to complete the construction
                loops, horizontals, verticals, i,
                lst, htube, h1, h2, vtube, x,
                cycle, loopless;

            loops:=Filtered(
                [1..l1-4],
                x->Length(Positions(bound[2],bound[2][x]))>1 and
                bound[2][x][2]<>1
            );

            horizontals:=Filtered(
                [1..l1-4],
                x->bound[2][x][2]=bound[2][x][3]-1
            );

            verticals:=Filtered(
                [1..l1-4],
                x->not (x in loops or x in horizontals)
            );
            verticals:=verticals+l1;

            for i in [1..Length(loops)/4]
                do
                lst:=[0,0];
                if 1 in grid[i]
                    then # check for corner configuration, important in deciding
                    lst[1]:=2; # which loop to use in the 2-cell (top/bottom)
                fi;
                if 2 in grid[i]
                    then
                    lst[2]:=4;
                fi;
                if 3 in grid[i]
                    then
                    lst[1]:=1;
                fi;
                if 4 in grid[i]
                    then
                    lst[2]:=3;
                fi;

                htube:=loops{lst+4*(i-1)};
                h1:=Filtered(
                    horizontals,
                    x->bound[2][x][2] in
                    [bound[2][htube[1]][2]..bound[2][htube[2]][2]]
                );
                h2:=Filtered(
                    horizontals,
                    x->bound[2][x][2] in
                    [bound[2][htube[1]][3]..bound[2][htube[2]][3]]
                );
                htube:=Concatenation(htube,h1,h2);
                Add(htube,Length(htube),1);
                Add(bound[3],htube);
            od;

            postpatch:=Length(bound[3]);

            loops:=loops+l1;

            vtube:=[];
            Add(vtube,verticals[1]);
            x:=bound[2][verticals[1]][3];
            cycle:=0;
            loopless:=[];
            for i in [2..Length(verticals)]
                do
                if bound[2][verticals[i]][2]=x
                    then
                    Add(vtube,verticals[i]);
                    x:=bound[2][verticals[i]][3];
                else
                    cycle:=cycle+1;
                    if cycle=2
                        then
                        cycle:=0;
                        Add(loopless,vtube);
                        vtube:=[];
                    fi;
                    x:=bound[2][verticals[i]][3];
                    Add(vtube,verticals[i]);
                fi;
            od;
            Add(loopless,vtube);

            for i in loopless
                do
                Add(i,Filtered(
                    loops,
                    y->bound[2][i[1]][2] in bound[2][y]{[2,3]})[1]
                );
                Add(i,Filtered(
                    loops,
                    y->bound[2][i[Length(i)-1]][3] in bound[2][y]{[2,3]})[2]
                );
                Add(i,Length(i),1);
                Add(bound[3],i);
            od;

            return bound;
        end;

        bound:=Patch(bound);

        Cap:=function(bound)
            local
                bottom, btm, top, tp,
                i, x, j, k;

            Add(bound[3],[2,l1-1,l1]); # the upper and lower
            Add(bound[3],[2,(2*l1)-1,2*l1]); # domes

            bottom:=[1..l2];
            btm:=[];
            for i in bound[3]{[prepatch+1..postpatch]}
                do
                x:=(Length(i)-3)/2;
                for j in [4..3+x]
                    do
                    for k in bottom
                        do
                        if 
                        i[j] in bound[3][k]{[2..Length(bound[3][k])]} and
                        i[j+x] in bound[3][k]{[2..Length(bound[3][k])]}
                            then
                            Add(btm,k);
                        fi;
                    od;
                od;
            od;

            bottom:=Difference(bottom,btm);
            bottom:=Concatenation(
                bottom, # all base 2-cells without the overlap
                [prepatch+1..postpatch], # the patch 2-cells enclosing the tubes
                [Length(bound[3])-1] # the dome
            );
            Add(bottom,Length(bottom),1);

            top:=[l2+1..2*l2];
            tp:=[];
            for i in bound[3]{[postpatch+1..Length(bound[3])-2]}
                do
                x:=(Length(i)-3)/2;
                for j in [2..1+x]
                    do
                    for k in top
                        do
                        if
                        i[j] in bound[3][k]{[2..Length(bound[3][k])]} and
                        i[j+x] in bound[3][k]{[2..Length(bound[3][k])]}
                            then
                            Add(tp,k);
                        fi;
                    od;
                od;
            od;

            top:=Difference(top,tp);
            top:=Concatenation(
                top,
                [postpatch+1..Length(bound[3])-2],
                [Length(bound[3])]
            );
            Add(top,Length(top),1);

            Add(bound[4],bottom);
            Add(bound[4],top);

            return bound;
        end;

        return Cap(bound);
    end;

    P:=PuncturedTube(P);
    P:=RegularCWComplex(P);

    for i in [1..Length(P!.boundaries[2])-Length(loop_correction)] do
        Add(loop_correction,0);
    od;

    P!.loopCorrection:=loop_correction;

    return P;
end);

# KnotComplementWithBoundary
################################################################################
############ Input: an arc presentation of some link K #########################
################################################################################
########### Output: an inclusion of CW-complexes f: b(K) -> B^3 \ K ############
################### where B^3 is homeomorphic to the 3-ball and b(K) ###########
################### denotes the boundary of an open tubular neighbourhood ######
################### of K in B^3 ################################################
################################################################################
InstallGlobalFunction(
    KnotComplementWithBoundary,
    function(arc)
    local
        comp, RegularCWKnot, knot, hcorrection,
        threshold, inclusion, iota, inv_mapping;

    comp:=KnotComplement(arc);

    RegularCWKnot:=function(arc)
        local
            D, len, signless, HollowTubes, max,
            bigGrid, correction, threshold, hcorrection, TubeJoiner;

        D:=arc;
        len:=Length(D);
        signless:=List(D,x->[AbsInt(x[1]),AbsInt(x[2])]);

        HollowTubes:=function(D)
            local
                grid, i, IsIntersection,
                CornerConfiguration, bound,
                bigGrid, GridFill, j, tick, correction, hcorrection,
                hslice1, hslice2, l1, l2, l3,
                max, vslice1, vslice2, threshold;

            grid:=List([1..len],x->List([1..len],y->0));
            for i in [1..len]
                do
                grid[len-i+1][D[i][1]]:=1;
                grid[len-i+1][D[i][2]]:=1;
            od;

            IsIntersection:=function(i,j)

                if grid[i][j]=0
                    then
                    if 1 in grid[i]{[1..j]}
                        then
                        if 1 in grid[i]{[j..len]}
                            then
                            if 1 in List([1..i],x->grid[x][j])
                                then
                                if 1 in List([i..len],x->grid[x][j])
                                    then
                                    return true;
                                fi;
                            fi;
                        fi;
                    fi;
                fi;

            return false;
            end;

            CornerConfiguration:=function(i,j);

                if grid[i][j]=1
                    then
                    if Size(Positions(grid[i]{[j..len]},1))=2
                        then
                        if Size(Positions(List([i..len],x->grid[x][j]),1))=2
                            then # Corner type 1, i.e : __
                            return 1; #                |
                        elif Size(Positions(List([1..i],x->grid[x][j]),1))=2
                            then # Corner type 3, i.e :
                            return 3; #                |__
                        fi;
                    elif Size(Positions(grid[i]{[1..j]},1))=2
                        then
                        if Size(Positions(List([i..len],x->grid[x][j]),1))=2
                            then # Corner type 2, i.e : __
                            return 2; #                   |
                        elif Size(Positions(List([1..i],x->grid[x][j]),1))=2
                            then # Corner type 4, i.e :
                            return 4; #                 __|
                        fi;
                    fi;
                fi;

                return 0;
            end;

            bound:=[[],[],[],[],[]];
            bigGrid:=List([1..2*len],x->List([1..2*len],y->0));

            GridFill:=function(c,i,j);
                if c=1 or c=4
                    then
                    bigGrid[(2*i)-1][(2*j)-1]:='*';
                    bigGrid[2*i][2*j]:='*';
                elif c=2 or c=3
                    then
                    bigGrid[(2*i)-1][2*j]:='*';
                    bigGrid[2*i][(2*j)-1]:='*';
                fi;
            end;

            for i in [1..len]
                do
                for j in [1..len]
                    do
                    if IsIntersection(i,j)
                        then
                        bigGrid[(2*i)-1][(2*j)-1]:='*';
                        bigGrid[(2*i)-1][2*j]:='*';
                        bigGrid[2*i][(2*j)-1]:='*';
                        bigGrid[2*i][2*j]:='*';
                    elif grid[i][j]=1
                        then
                        GridFill(CornerConfiguration(i,j),i,j);
                    fi;
                od;
            od;

            tick:=1;
            for i in [1..2*len]
                do
                for j in [1..2*len]
                    do
                    if bigGrid[i][j]='*'
                        then
                        bigGrid[i][j]:=tick;
                        tick:=tick+1;
                    fi;
                od;
            od;

    # UPDATE: needed to account for configuration of corners at the end-step
    # (i.e. when matching the loops of one layer to the other).
    # There are sometimes disparities in the ordering on 1-cells from
    # left-to-right vs. when ordering from top-to-bottom. Not realising this was
    # causing 111 of the pre-stored knots in HAP to yield incorrect
    # CW-decomposition.
            correction:=[];
            hcorrection:=[];
            for i in [1..len] do
                for j in [1..len] do
                    if CornerConfiguration(i,j)<>0 then
                        if CornerConfiguration(i,j) in [1,4] then
                            Add(correction,1);
                            Add(correction,-1);
                            Add(hcorrection,2);
                            Add(hcorrection,1);
                        else
                            Add(correction,0);
                            Add(correction,0);
                            Add(hcorrection,1);
                            Add(hcorrection,2);
                        fi;
                    fi;
                od;
            od;

            ### add the 0, 1 & 2-cells ###
            ########## to bound ##########
            for i in [1..2*Maximum(bigGrid[Length(bigGrid)])] do
                Add(bound[1],[1,0]);
            od;

            for i in [1..len] do # add the 'horizontal' 2-cells
                hslice1:=Filtered(bigGrid[2*i-1],x->x<>0);
                hslice2:=Filtered(bigGrid[2*i],x->x<>0);
                l2:=Length(bound[2]);
                for j in [1..Length(hslice1)-1] do
                    Add(
                        bound[2],
                        [2,hslice1[j],hslice2[j]]
                    );
                    if j=1 then
                        Add(
                            bound[2],
                            [2,hslice1[j],hslice2[j]]
                        );
                    fi;
                    if j<>1 then
                        l1:=Length(bound[2]);
                        Add(
                            bound[3],
                            [4,l1-3,l1-2,l1-1,l1]
                        );
                    fi;
                    Add(
                        bound[2],
                        Concatenation([2],hslice1{[j,j+1]})
                    );
                    Add(
                        bound[2],
                        Concatenation([2],hslice2{[j,j+1]})
                    );
                    if j=Length(hslice1)-1 then
                        Add(
                            bound[2],
                            [2,hslice1[j+1],hslice2[j+1]]
                        );
                        l1:=Length(bound[2]);
                        Add(
                            bound[2],
                            [2,hslice1[j+1],hslice2[j+1]]
                        );
                        Add(
                            bound[3],
                            [4,l1-3,l1-2,l1-1,l1]
                        );
                    fi;
                od;
                l3:=Concatenation(
                    [l2+1],
                    Filtered(
                        [l2+3..Length(bound[2])-2],
                        x->AbsInt(bound[2][x][2]-bound[2][x][3])=1
                    ),
                    [Length(bound[2])]
                );
                Add(l3,Length(l3),1);
                Add(bound[3],l3);
            od;

            max:=Maximum(bigGrid[Length(bigGrid)]);
            for i in [1..2*len] do
                for j in [1..2*len] do
                    if bigGrid[i][j]<>0 then
                        bigGrid[i][j]:=bigGrid[i][j]+max;
                    fi;
                od;
            od;

            for i in [1..len] do # add the 'vertical' 2-cells
                vslice1:=Filtered(List([1..2*len],x->bigGrid[x][2*i-1]),x->x<>0);
                vslice2:=Filtered(List([1..2*len],x->bigGrid[x][2*i]),x->x<>0);
                l2:=Length(bound[2]);
                for j in [1..Length(vslice1)-1] do
                    Add(
                        bound[2],
                        Concatenation(
                            [2],
                            Set(
                                [vslice1[j],
                                vslice2[j]]
                            )
                        )
                    );
                    if j=1 then
                        Add(
                            bound[2],
                            Concatenation(
                                [2],
                                Set(
                                    [vslice1[j],
                                    vslice2[j]]
                                )
                            )
                        );
                    fi;
                    if j<>1 then
                        l1:=Length(bound[2]);
                        Add(
                            bound[3],
                            [4,l1-3,l1-2,l1-1,l1]
                        );
                    fi;
                    Add(
                        bound[2],
                        Concatenation([2],Set(vslice1{[j,j+1]}))
                    );
                    Add(
                        bound[2],
                        Concatenation([2],Set(vslice2{[j,j+1]}))
                    );
                    if j=Length(vslice1)-1 then
                        Add(
                            bound[2],
                            Concatenation(
                                [2],
                                Set(
                                    [vslice1[j+1],
                                    vslice2[j+1]]
                                )
                            )
                        );
                        l1:=Length(bound[2]);
                        Add(
                            bound[2],
                            Concatenation(
                                [2],
                                Set(
                                    [vslice1[j+1],
                                    vslice2[j+1]]
                                )
                            )
                        );
                        Add(
                            bound[3],
                            [4,l1-3,l1-2,l1-1,l1]
                        );
                    fi;
                od;
                l3:=Concatenation(
                    [l2+1],
                    Filtered(
                        [l2+3..Length(bound[2])-2],
                        x-> not
                        (bound[2][x][2] in vslice1 and bound[2][x][3] in vslice2)
                        and
                        not
                        (bound[2][x][2] in vslice2 and bound[2][x][3] in vslice1)
                    ),
                    [Length(bound[2])]
                );
                Add(l3,Length(l3),1);
                Add(bound[3],l3);
            od;

            threshold:=Length(bound[2])/2;
            ##############################

            return [max,bound,bigGrid,correction,threshold,hcorrection];
        end;

        D:=HollowTubes(D);
        max:=D[1];
        bigGrid:=D[3];
        correction:=D[4];
        threshold:=D[5];
        hcorrection:=D[6];
        D:=D[2];

        TubeJoiner:=function(D)
            local
                loops, size, hloops, vloops,
                i, l;

            loops:=Filtered([1..Length(D[2])],x->Length(Positions(D[2],D[2][x]))=2);
            size:=Length(loops)/2;
            hloops:=loops{[1..size]};
            vloops:=List([1..size],x->Position(D[2],D[2][hloops[x]]+[0,max,max]));
            for i in [1..size] do
                if i mod 2 = 0 then
                    vloops[i]:=vloops[i]+1;
                fi;
            od;
            vloops:=vloops+correction;

            for i in [1..size/2] do
                Add(D[2],[2,D[2][hloops[2*i]][2],D[2][vloops[2*i]][2]]);
                Add(D[2],[2,D[2][hloops[2*i]][3],D[2][vloops[2*i]][3]]);
                l:=Length(D[2]);

                Add(D[3],[4,hloops[2*i-1],vloops[2*i-1],l-1,l]);
                Add(D[3],[4,hloops[2*i],vloops[2*i],l-1,l]);
            od;

            return D;
        end;

        D:=TubeJoiner(D);
        D:=RegularCWComplex(D);
        D!.grid:=bigGrid;
        D!.arcPresentation:=arc;

        return [D,hcorrection,threshold];
    end;

    knot:=RegularCWKnot(arc);
    hcorrection:=knot[2];
    threshold:=knot[3];
    knot:=knot[1];

    inclusion:=function(bound)
        local
            bound1, bound2, len,
            1c1, 1c2, 2c2, HorizontalIndex, inc;

        bound1:=bound[1];
        bound2:=bound[2];

        len:=Length(bound1[1])/2;

        1c1:=bound1[2]*1;
        1c1:=List(
            1c1,
            x->Concatenation(
                [2],
                [x[2]+1+2*Int((x[2]-1)/len),
                x[3]+1+2*Int((x[3]-1)/len)]
            )
        );

        1c2:=bound2[2]*1;
        1c2:=List(
            1c2,
            x->Concatenation(
                [2],
                Set(
                    [x[2],x[3]]
                )
            )
        );

        2c2:=List(bound2[3],x->Concatenation([x[1]],Set(x{[2..Length(x)]})));

        HorizontalIndex:=function(n)

            return hcorrection[
                Position(
                    Filtered(
                        [1..threshold],
                        x->Length(
                            Positions(
                                bound1[2],
                                bound1[2][x]
                            )
                        )=2
                    ),n
                )
            ];
        end;

        inc:=function(n,k)
            local
                ind, 2cell;

            if n=0 then
                return k+1+2*Int((k-1)/len);
            elif n=1 then
                ind:=1;
                if k in [1..threshold] then
                    if k>1 and 1c1[k-1]=1c1[k] then
                        ind:=HorizontalIndex(k);
                    elif 1c1[k]=1c1[k+1] then
                        ind:=HorizontalIndex(k);
                    fi;
                elif k>threshold then
                    if 1c1[k-1]=1c1[k] then
                        ind:=2;
                    elif k<Length(1c1) and 1c1[k]=1c1[k+1] then
                        ind:=1;
                    fi;
                fi;
                return Positions(1c2,1c1[k])[ind];
            elif n=2 then
                2cell:=List(bound1[3][k]{[2..Length(bound1[3][k])]},x->inc(1,x));
                2cell:=Concatenation([Length(2cell)],Set(2cell));
                return Position(2c2,2cell);
            else
                return fail;
            fi;
        end;

        return inc;
    end;

    iota:=inclusion([knot!.boundaries,comp!.boundaries]);

    inv_mapping:=[[],[],[]];
    inv_mapping[1]:=List([1..knot!.nrCells(0)],x->iota(0,x));
    inv_mapping[2]:=List([1..knot!.nrCells(1)],x->iota(1,x));
    inv_mapping[3]:=List([1..knot!.nrCells(2)],x->iota(2,x));

    return Objectify(
        HapRegularCWMap,
        rec(
            source:=knot,
            target:=comp,
            mapping:=iota,
            properties:=[
                ["image",inv_mapping]
            ]
        )
    );
end);

# ArcPresentationToKnottedOneComplex
################################################################################
############ Input: an arc presentation ########################################
################################################################################
########### Output: an inclusion map of regular CW-complexes from ##############
################### a 1-dimensional link to a 3-dimensional ball ###############
################################################################################
InstallGlobalFunction(
 ArcPresentationToKnottedOneComplex,
 function(arc)
    local
        gn, grid, i, kbnd, bnd, map, imap,
        IsIntersection, ints, ext_ints, j, 0c,
        B2Decomposition, B3Decomposition, embed;

    gn:=Length(arc); # the grid number
    
    grid:=List([1..5*gn],x->[1..5*gn]*0); # form a (3*gn) x gn
    for i in [0..gn-1] do # matrix from the arc presentation
        grid[5*(gn-i)-2][5*arc[i+1][1]-2]:=1;
        grid[5*(gn-i)-2][5*arc[i+1][2]-2]:=1;
    od;
    grid:=FrameArray(grid);

    kbnd:=List([1..3],x->[]); # boundary list of the knot
    bnd:=List([1..5],x->[]); # boundary list of the complement of the knot
    map:=List([1..2],x->[]); # inclusion map from kbnd to bnd
    imap:=List([1..4],x->[]); # inverse image of the above inclusion map

    IsIntersection:=function(i,j) # finds where crossings occur in the grid
        if grid[i][j]=0 then
            if 1 in grid[i]{[1..j]} then
                if 1 in grid[i]{[j..5*gn+2]} then
                    if 1 in List([1..i],x->grid[x][j]) then
                        if 1 in List([i..5*gn+2],x->grid[x][j]) then
                            return true;
                        fi;
                    fi;
                fi;
            fi;
        fi;

        return false;
    end;

    ints:=[]; # records the coordinates of each crossing
    ext_ints:=[]; # records those 0-cells which arise in intersection points
    for i in [1..5*gn+2] do
        for j in [1..5*gn+2] do
            if IsIntersection(i,j) then
                Add(ext_ints,[i-1,j]); Add(ext_ints,[i+1,j]);
                Add(ints,[i,j]);
                grid[i-1][j]:='*';
                grid[i][j]:='*';
                grid[i+1][j]:='*';
            fi;
        od;
    od;

    0c:=4; # label the entries of grid so that it models the 0-skeleton
    for i in [1..5*gn+2] do
        for j in [1..5*gn+2] do
            if grid[i][j]<>0 then
                grid[i][j]:=0c;
                0c:=0c+1;
            fi;
        od;
    od;
    0c:=0c+2;

    ints:=List(ints,x->grid[x[1],x[2]]);

    B2Decomposition:=function()
# takes what we have so far and uses it to form a regular CW-decomposition of
# the 2-ball with the appropriate inclusion map
        local i, j, hslice, vslice, 2SkeletonOfDisk, DuplicateDisk;

        kbnd[1]:=List([1..0c-6],x->[1,0]);
        bnd[1]:=List([1..0c],x->[1,0]);
        map[1]:=[1..0c-6]+3;
        imap[1]:=Concatenation([0,0,0],map[1]-3,[0,0,0]);

        Add(bnd[2],[2,1,2]); Add(bnd[2],[2,1,3]); Add(bnd[2],[2,2,0c-2]);
        Add(bnd[2],[2,3,0c-1]); Add(bnd[2],[2,0c-2,0c]);
        Add(bnd[2],[2,0c-1,0c]);
        Add(bnd[2],[2,3,4]); Add(bnd[2],[2,0c-3,0c-2]);
        # add some 1-cells to just the complement to stay regular
        # these act as a frame to the knot

        for i in [1..8] do
            Add(imap[2],0);
        od;

        for i in [1..5*gn] do # add the horizontal arcs of the knot first
            hslice:=[];
            for j in [1..5*gn] do
                if grid[i][j]<>0 and not [i,j] in ext_ints then
                    Add(hslice,grid[i][j]);
                fi;
            od;
            for j in [1..Length(hslice)-1] do
                Add(kbnd[2],[2,hslice[j]-3,hslice[j+1]-3]);
                Add(bnd[2],[2,hslice[j],hslice[j+1]]);
                Add(map[2],Length(bnd[2]));
                Add(imap[2],Length(kbnd[2]));
            od;
        od;
        for j in [1..5*gn] do # now add the vertical arcs
            vslice:=[];
            for i in [1..5*gn] do
                if grid[i][j]<>0 then
                    Add(vslice,grid[i][j]);
                fi;
            od;
            for i in [1..Length(vslice)-1] do
                Add(bnd[2],[2,vslice[i],vslice[i+1]]);
                if not(vslice[i] in ints or vslice[i+1] in ints) then
                    Add(kbnd[2],[2,vslice[i]-3,vslice[i+1]-3]); # introduce a 
                    Add(map[2],Length(bnd[2])); # gap in the knot to be 'lifted' 
                    Add(imap[2],Length(kbnd[2])); # and filled in later
                else
                    Add(imap[2],0);
                fi;
            od;
        od;

        2SkeletonOfDisk:=function(bnd)
            local
                ori, i, j, cell, top, rgt, btm, lft,
                Clockwise, path, FaceTrace;

            grid[1][1]:=1; grid[1][5*gn+2]:=2; grid[4][1]:=3;
            grid[5*gn-1][5*gn+2]:=0c-2; grid[5*gn+2][1]:=0c-1;
            grid[5*gn+2][5*gn+2]:=0c;

            ori:=List([1..0c],x->[1..4]*0);
            # each 0-cell will have the 0-cells N/E/S/W of it
            # listed in that order 

            for i in [1..5*gn+2] do
                for j in [1..5*gn+2] do
                    cell:=grid[i][j];
                    if cell<>0 then
                        top:=List([1..i-1],x->grid[x][j]);
                        top:=Filtered(top,x->x<>0);
                        if top<>[] then
                            ori[cell][1]:=Position
                            (
                                bnd[2],
                                Concatenation([2],Set([cell,top[Length(top)]]))
                            );
                        fi;
                        rgt:=grid[i]{[j+1..5*gn+2]};
                        rgt:=Filtered(rgt,x->x<>0);
                        if rgt<>[] then
                            ori[cell][2]:=Position
                            (
                                bnd[2],
                                Concatenation([2],Set([cell,rgt[1]]))
                            );
                        fi;
                        btm:=List([i+1..5*gn+2],x->grid[x][j]);
                        btm:=Filtered(btm,x->x<>0);
                        if btm<>[] then
                            ori[cell][3]:=Position(
                                bnd[2],
                                Concatenation([2],Set([cell,btm[1]]))
                            );
                        fi;
                        lft:=grid[i]{[1..j-1]};
                        lft:=Filtered(lft,x->x<>0);
                        if lft<>[] then
                            ori[cell][4]:=Position(
                                bnd[2],
                                Concatenation([2],Set([cell,lft[Length(lft)]]))
                            );
                        fi;
                        if [i,j] in ext_ints then # 0-cells in ext_ints
                            ori[cell][2]:=0; # never have edges from the 
                            ori[cell][4]:=0; # left or right of them
                        fi;
                    fi;
                od;
            od;

            
################################################################################
# repurposed from KnotComplement and KnotComplementWithBoundary
            FaceTrace:=function(path)
                local
                    unselected, sourceORtarget, x, ClockwiseTurn,
                    2cell, sORt, dir, e1, e0, i, bool;

                unselected:=Concatenation
                (
                    [1..Length(bnd[2])],
                    [7..Length(bnd[2])] # the first 6 1-cells occur just once
                );

                ClockwiseTurn:=function(p,e)
                    local f;
                    
                    f:=(Position(p,e) mod 4)+1;
                    while p[f]=0 do
                        f:=(f mod 4)+1;
                    od;
                    
                    return p[f];
                end;

                bool:=false;
                sourceORtarget:=List([1..Length(bnd[2])],y->[3,2]);
                x:=1;
                while unselected<>[] do
                    while (not x in unselected) and (not e1 in unselected) do
                        x:=x+1;
                    od;
                    2cell:=[x];
                    sORt:=sourceORtarget[x][Length(sourceORtarget[x])];
                    Unbind(sourceORtarget[x][Length(sourceORtarget[x])]);

                    dir:=path[bnd[2][x][sORt]];
                    e0:=bnd[2][x][sORt];
                    e1:=ClockwiseTurn(dir,x);
                    while e1<>x do
                        Add(2cell,e1);
                        e0:=Filtered(bnd[2][e1]{[2,3]},y->y<>e0)[1];
                        dir:=path[e0];
                        e1:=ClockwiseTurn(dir,e1);
                    od;
                    Add(2cell,Length(2cell),1);
                    if (not Set(2cell) in List(bnd[3],x->Set(x))) then
                        for i in Filtered(
                            2cell{[2..Length(2cell)]},
                            y->y in unselected
                        ) do
                            Unbind(unselected[Position(unselected,i)]);
                        od;
                        if not bool then # to save some checks
                            if Set(2cell)=[1,2,3,4,5,6] then
                                bool:=true;
                            else
                                Add(bnd[3],2cell);
                                Add(imap[3],0);
                            fi;
                        else
                            Add(bnd[3],2cell);
                            Add(imap[3],0);
                        fi;
                    fi;
                od;
################################################################################
                bnd[3]:=List(
                    bnd[3],
                    x->Concatenation(
                        [x[1]],
                        Set(x{[2..Length(x)]})
                    )
                ); # order the 2-cells nicely
            end;
            FaceTrace(ori);
        end;
        2SkeletonOfDisk(bnd);
    end;
    B2Decomposition();

    B3Decomposition:=function()
        local 
            k0, b0, k1, b1, b2, DuplicateDisk, b22, CrossI, 3c;

        k0:=Length(kbnd[1]); b0:=Length(bnd[1]);
        k1:=Length(kbnd[2]); b1:=Length(bnd[2]);
        b2:=Length(bnd[3]);

        DuplicateDisk:=function() # make a duplicate of everything
            local i, n, mult;

            for i in [1..Length(ext_ints)/2] do
                Add(kbnd[1],[1,0]);
                Add(kbnd[1],[1,0]);
                Add(kbnd[1],[1,0]);
            od;

            bnd[1]:=Concatenation(bnd[1],bnd[1]);

            imap[1]:=Concatenation(imap[1],imap[1]+Length(kbnd[1])-k0);
            for i in [b0+1..2*b0] do
                if imap[1][i]=Length(kbnd[1])-k0 then
                    imap[1][i]:=0;
                fi;
            od;

            n:=k0+1;
            mult:=1;
            for i in [1..b1] do
                Add(bnd[2],bnd[2][i]+[0,b0,b0]);
                if i>8 and not (bnd[2][i]-[0,3,3] in kbnd[2]) then
                    Add(
                        kbnd[2],
                        Concatenation
                        (
                            [2],
                            [n,n+1]
                        )
                    );
                    n:=n+1+Int(mult/2);

                    Add(map[1],bnd[2][i][2]+b0);
                    if Int(mult/2)=1 then 
                        mult:=1;
                        Add(map[1],bnd[2][i][3]+b0);
                    else
                        mult:=2;
                    fi;

                    Add(map[2],Length(bnd[2]));
                    Add(imap[2],Length(map[2]));
                else
                    Add(imap[2],0);
                fi;
            od;

            for i in [1..b2] do
                Add(
                    bnd[3],
                    Concatenation(
                        [bnd[3][i][1]],
                        bnd[3][i]{[2..Length(bnd[3][i])]}+b1
                    )
                );
                Add(imap[3],0);
            od;

            return Length(bnd[3]);
        end;
        b22:=DuplicateDisk();

        CrossI:=function() # connect the two disks 
            local l, i, j, n, bool, 3cell;
            # each n-cell gives rise to an (n+1)-cell

            l:=[];
            for i in [1..5*gn+2] do
                for j in [1..5*gn+2] do
                    if grid[i][j]<>0 then
                        Add(l,grid[i][j]);
                    fi;
                od;
            od;

            n:=k0+1;
            bool:=false;
            for i in l do
                Add(bnd[2],[2,i,i+b0]);
                if i in List(ext_ints,x->grid[x[1]][x[2]]) then
                    Add(kbnd[2],[2,i-3,n]);
                    if not bool then
                        n:=n+2; bool:=true;
                    else
                        n:=n+1; bool:=false;
                    fi;
                    Add(map[2],Length(bnd[2]));
                    Add(imap[2],Length(map[2]));
                else
                    Add(imap[2],0);
                fi;
            od;

            for i in [1..b1] do
                Add(
                    bnd[3],
                    [
                        4,
                        i,
                        i+b1,
                        Position(
                            bnd[2],
                            [
                                2,
                                bnd[2][i][2],
                                bnd[2][i+b1][2]
                            ]
                        ),
                        Position(
                            bnd[2],
                            [
                                2,
                                bnd[2][i][3],
                                bnd[2][i+b1][3]
                            ]
                        )
                    ]
                );
                Add(imap[4],[i,Length(bnd[3])]); # not exactly the inverse
            od; # image any more, but this list is used directly below

            for i in [1..b2] do
                3cell:=Concatenation(
                    [
                        i,
                        i+b2
                    ],
                    List(
                        bnd[3][i]{[2..Length(bnd[3][i])]},
                        x->imap[4]
                            [
                                Position(
                                    List(imap[4],y->y[1]),
                                    x
                                )
                            ][2]
                    )
                );
                Add(3cell,Length(3cell),1);
                Add(bnd[4],3cell);
            od;
        end;
        CrossI();

        # add a cap to B3 /// not sure if necessary
        Add(bnd[3],[6,1,2,3,4,5,6]);
        Add(bnd[3],[6,b1+1,b1+2,b1+3,b1+4,b1+5,b1+6]);
        3c:=Concatenation([Length(bnd[3])-1],[1..b2]);
        Add(3c,Length(3c),1);
        Add(bnd[4],3c);
        3c:=Concatenation([Length(bnd[3])],[b2+1..b22]);
        Add(3c,Length(3c),1);
        Add(bnd[4],3c);

    end;
    B3Decomposition();

    embed:={n,k}->map[n+1][k];

    #return [map,grid,kbnd,bnd];
    return Objectify(
        HapRegularCWMap,
        rec(
            source:=RegularCWComplex(kbnd),
            target:=RegularCWComplex(bnd),
            mapping:=embed,
   grid:=grid
        )
    );
end);

# ArcDiagramToTubularSurface
################################################################################
############ Input: a list [arc,crs,col] where arc is an arc presentation, #####
################### crs is a list whose entries are -1, 0 or 1 and whose #######
################### length is the number of crossings in arc and col is ########
################### a list whose entries are 1, 2, 3 or 4 corresponding to #####
################### colours as detailed below ##################################
################################################################################
########### Output: an inclusion of regular CW-complexes from a self- ##########
################### intersecting tubular surface into the 3-ball ###############
################################################################################
InstallGlobalFunction(
    ArcDiagramToTubularSurface,
    function(arc)
    local
        prs, crs, clr, grd, i, IsIntersection,
        CornerConfiguration, GRD, crossings, j,
        k, nr0cells, bnd, sub, hbars, hslice, cell,
        int, max, vbars, vslice, loops1, loops2,
        unchosen, neighbours, Clockwise,
        path, unselectedEdges, sourceORtarget,
        faceloops, x, ClockwiseTurn, 2cell, sORt,
        ori, e1, e0, loops, present_loops, vertices,
        check, l0, l1, l2, l1_, l2_, IsEdgeInDuplicate,
        copy1, hbars2, vbars2, copy2, 3cell, colour, lcap, reg,
        closure, ucap, l1__, l2__, path_comp, pipes, HorizontalOrVertical,
        l, AboveBelow0Cell, IntersectingCylinders, pos, colour_,Last;
Last:=function(L); return L[Length(L)]; end;
    if IsList(arc[1][1]) then
        prs:=arc[1]*1;
        crs:=arc[2]*1;
#                -1 |     +1 |      0 |
# crossing types: --|-- or ----- or --+--
#                   |        |        |
        if Length(arc)=3 then
            clr:=arc[3]*1;
# colours: 1; bgb, 2; bgr, 3; rgb, 4; rgr
        fi;
    else
        prs:=arc*1;
    fi;

# (i) the 0-skeleton of the disk
####################################################################################
    grd:=List([1..Length(prs)],x->[1..Length(prs)]*0);
    for i in [0..Length(prs)-1] do
        grd[Length(prs)-i][prs[i+1][1]]:=1;
        grd[Length(prs)-i][prs[i+1][2]]:=1;
    od;

    IsIntersection:=function(i,j)
        if grd[i][j]=0 and
            1 in grd[i]{[1..j]} and
                1 in grd[i]{[j..Length(prs)]} and
                    1 in List([1..i],x->grd[x][j]) and
                        1 in List([i..Length(prs)],x->grd[x][j]) then
            return true;
        fi;
        return false;
    end;
    CornerConfiguration:=function(i,j);
        if grd[i][j]=1 then
            if Size(Positions(grd[i]{[j..Length(prs)]},1))=2 then
                if Size(Positions(List([i..Length(prs)],x->grd[x][j]),1))=2 then
                        # Corner type 1, i.e :  __
                    return 1; #                |
                elif Size(Positions(List([1..i],x->grd[x][j]),1))=2 then
                        # Corner type 3, i.e :
                    return 3; #                |__
                fi;
            elif Size(Positions(grd[i]{[1..j]},1))=2 then
                if Size(Positions(List([i..Length(prs)],x->grd[x][j]),1))=2 then
                        # Corner type 2, i.e :  __
                    return 2; #                   |
                elif Size(Positions(List([1..i],x->grd[x][j]),1))=2 then
                        # Corner type 4, i.e :
                    return 4; #                 __|
                fi;
            fi;
        fi;
        return 0;
    end;
    
    GRD:=List([1..4*Length(prs)],x->[1..4*Length(prs)]*0);
    crossings:=[];
# quadruple the size of grd to allow for the 0-skeleton
# to be displayed nicely without overlap in an array
    for i in [1..Length(prs)] do
        for j in [1..Length(prs)] do
            if CornerConfiguration(i,j) in [1,4] then
                GRD[4*i-3][4*j-3]:=1;
                GRD[4*i][4*j]:=1;
            elif CornerConfiguration(i,j) in [2,3] then
                GRD[4*i-3][4*j]:=1;
                GRD[4*i][4*j-3]:=1;
            elif IsIntersection(i,j) then
                for k in [0,3] do
                    GRD[4*i-3][4*j-3+k]:=1;
                    GRD[4*i][4*j-3+k]:=1;
                    Add(crossings,[4*i-3,4*j-3+k]);
                    Add(crossings,[4*i,4*j-3+k]);
                od;
            fi;
        od;
    od;
# label the 0-cells row by row
    nr0cells:=2;
    for i in [1..4*Length(prs)] do
        for j in [1..4*Length(prs)] do
            if GRD[i][j]=1 then
                GRD[i][j]:=nr0cells;
                nr0cells:=nr0cells+1;
            fi;
        od;
    od;
    crossings:=List(crossings,x->GRD[x[1]][x[2]]);
    crossings:=List([1..Length(crossings)/4],x->List([1..4]+4*x-4,y->crossings[y]));
    GRD:=FrameArray(GRD);
    GRD[1][1]:=1;
    GRD[4*Length(prs)+2][4*Length(prs)+2]:=nr0cells;

    bnd:=List([1..5],x->[]); # eventual boundary list of the 3-ball containing
    sub:=List([[],[],[]]); # the boundary of a knotted surface as a subcomplex
    bnd[1]:=List([1..nr0cells],x->[1,0]);
    sub[1]:=[2..nr0cells-1];
    if IsBound(crs) then
        for i in [1..Length(crs)] do
            if crs[i]=0 then
                sub[1]:=Difference(sub[1],crossings[i]);
            fi;
        od;
    fi;
####################################################################################

# (ii) the 1-skeleton of the disk
####################################################################################
    # add the horizontal 1-cells
    hbars:=[];
    for i in [2..Length(GRD)-1] do
        hslice:=Filtered(GRD[i],x->x<>0);
        if hslice<>hslice*0 then
            Add(hbars,hslice);
        fi;
        for j in [1..Length(hslice)-1] do
            cell:=[2,hslice[j],hslice[j+1]];
            Add(bnd[2],cell);
            int:=List(crossings,x->Length(Intersection(cell{[2,3]},x)));
            max:=PositionMaximum(int);
            if IsBound(crs) then
                if int[max]=1 and
                    crs[max]=-1 and
                        not Length(bnd[2]) in sub[2] then
                            Add(sub[2],Length(bnd[2]));
                elif int[max]=2 and
                    crs[max]<>0 and
                        not Length(bnd[2]) in sub[2] then
                            Add(sub[2],Length(bnd[2])); 
                fi;
            else
                if max<>fail then
                    if int[max]=2 then #  horizontal 1-cells default to the top
                        Add(sub[2],Length(bnd[2])); # so they're not all included here
                    fi;
                fi;
            fi;
        od;
    od;
    hbars:=List([1..Length(hbars)/2],x->Concatenation(hbars[2*x-1],hbars[2*x]));

    # add the vertical 1-cells
    vbars:=[];
    for i in TransposedMat(GRD){[2..Length(GRD)-1]} do
        vslice:=Filtered(i,x->x<>0);
        if vslice<>vslice*0 then
            Add(vbars,vslice);
        fi;
        for j in [1..Length(vslice)-1] do
            cell:=[2,vslice[j],vslice[j+1]];
            Add(bnd[2],cell);
            int:=List(crossings,x->Length(Intersection(cell{[2,3]},x)));
            max:=PositionMaximum(int);
            if IsBound(crs) then
                if int[max]=1 then
                    if crs[max]=1 and
                        not Length(bnd[2]) in sub[2] then
                            Add(sub[2],Length(bnd[2]));
                    fi;
                elif int[max]=2 then
                    if crs[max]<>0 and
                        not Length(bnd[2]) in sub[2] then
                            Add(sub[2],Length(bnd[2]));
                    fi;
                else
                    Add(sub[2],Length(bnd[2]));
                fi;
            else
                Add(sub[2],Length(bnd[2])); # vertical 1-cells default to the bottom
            fi;
        od;
    od;
    vbars:=List([1..Length(vbars)/2],x->Concatenation(vbars[2*x-1],vbars[2*x]));

    # add the loops
    for i in [2,6..Length(GRD)-4] do
        loops1:=Filtered(GRD[i],x->x<>0);
        loops2:=Filtered(GRD[i+3],x->x<>0);
        for j in [1,2] do
            Add(bnd[2],[2,loops1[1],loops2[1]]);
            Add(sub[2],Length(bnd[2])); # loops always in subcomplex... for now
            Add(bnd[2],[2,loops1[Length(loops1)],loops2[Length(loops2)]]);
            Add(sub[2],Length(bnd[2]));
        od;
    od;

    # add the remaining four 1-cells to keep things regular
    Add(bnd[2],[2,1,2]); Add(bnd[2],[2,nr0cells-1,nr0cells]);
    Add(bnd[2],[2,1,nr0cells]); Add(bnd[2],[2,1,nr0cells]);
####################################################################################

# (iii) the 2-skeleton of the disk
####################################################################################
    unchosen:=List(bnd[2],x->x{[2,3]});
    neighbours:=List(bnd[1],x->[]);

    for i in [1..Length(bnd[1])] do
        for j in [1..Length(unchosen)] do
            if i in unchosen[j] then
                Add(neighbours[i],j);
            fi;
        od;
    od;

    Clockwise:=function(neighbours)
        local
            oriented, first0, last0,
            i, j, x, k, l, posi, posx;

        oriented:=List(neighbours,x->List([1..12],y->"pass"));
        first0:=SortedList(neighbours[1]);
        last0:=SortedList(neighbours[Length(neighbours)]);

        oriented[1][7]:=first0[1];
        oriented[1][6]:=first0[3];
        oriented[1][8]:=first0[2];
        oriented[Length(oriented)][1]:=last0[1]; 
        oriented[Length(oriented)][2]:=last0[3];
        oriented[Length(oriented)][12]:=last0[2];

        for i in [2..Length(neighbours)-1] do
            for j in [1..Length(neighbours[i])] do
                x:=bnd[2][neighbours[i][j]];
                x:=Filtered(x{[2,3]},y->y<>i)[1];
                for k in [1..Length(GRD)] do
                    for l in [1..Length(GRD[1])] do
                        if i=GRD[k][l] then
                            posi:=[k,l];
                        fi;
                        if x=GRD[k][l]then
                            posx:=[k,l];
                        fi;
                    od;
                od;
                # _\\|//_
                #  //|\\
                if posi[1]>posx[1] then
                    if posi[2]=posx[2] then
                        oriented[i][1]:=neighbours[i][j];
                    elif posi[2]<posx[2] then
                        if oriented[i][2]="pass" then
                            oriented[i][2]:=neighbours[i][j];
                        else
                            oriented[i][3]:=neighbours[i][j];
                        fi;
                    elif posi[2]>posx[2] then
                        if oriented[i][12]="pass" then
                            oriented[i][12]:=neighbours[i][j];
                        else
                            oriented[i][11]:=neighbours[i][j];
                        fi;
                    fi;
                elif posi[1]=posx[1] then
                    if posi[2]<posx[2] then
                        oriented[i][4]:=neighbours[i][j];
                    elif posi[2]>posx[2] then
                        oriented[i][10]:=neighbours[i][j];
                    fi;
                elif posi[1]<posx[1] then
                    if posi[2]=posx[2] then
                        oriented[i][7]:=neighbours[i][j];
                    elif posi[2]<posx[2] then
                        if oriented[i][5]="pass" then
                            oriented[i][5]:=neighbours[i][j];
                        else
                            oriented[i][6]:=neighbours[i][j];
                        fi;
                    elif posi[2]>posx[2] then
                        if oriented[i][9]="pass" then
                            oriented[i][9]:=neighbours[i][j];
                        else
                            oriented[i][8]:=neighbours[i][j];
                        fi;
                    fi;
                fi;
            od;
        od;
        
        return oriented;
    end;

    path:=Clockwise(neighbours);

    unselectedEdges:=List([1..Length(bnd[2])-2]);
    unselectedEdges:=Concatenation(unselectedEdges,unselectedEdges); # use Append() instead
    Add(unselectedEdges,Length(bnd[2])-1);
    Add(unselectedEdges,Length(bnd[2]));

    ClockwiseTurn:=function(p,e)
        local f;
        f:=(Position(p,e) mod 12)+1;
        while p[f]="pass" do
            f:=(f mod 12)+1;
        od;
        return p[f];
    end;

    sourceORtarget:=List([1..Length(bnd[2])],y->[3,2]);
    x:=1;
    while unselectedEdges<>[] do
        while (not x in unselectedEdges) and (not e1 in unselectedEdges) do
            x:=x+1;
        od;
        2cell:=[x];
        sORt:=sourceORtarget[x][Length(sourceORtarget[x])];
        Unbind(sourceORtarget[x][Length(sourceORtarget[x])]);

        ori:=path[bnd[2][x][sORt]];
        e0:=bnd[2][x][sORt];
        e1:=ClockwiseTurn(ori,x);
        while e1<>x do
            Add(2cell,e1);
            e0:=Filtered(bnd[2][e1]{[2,3]},y->y<>e0)[1];
            ori:=path[e0];
            e1:=ClockwiseTurn(ori,e1);
        od;
        Add(2cell,Length(2cell),1);
        if not Set(2cell) in List(bnd[3],Set) then
            for i in Filtered(2cell{[2..Length(2cell)]},y->y in unselectedEdges) do
                Unbind(unselectedEdges[Position(unselectedEdges,i)]);
            od;
            Add(bnd[3],2cell);
            if Length(Intersection(2cell{[2..2cell[1]+1]},sub[2]))=2cell[1] and
                2cell[1]<>2 then
                    Add(sub[3],Length(bnd[3]));
            fi;
        fi;
    od;
    bnd[3]:=List(bnd[3],x->Concatenation([x[1]],Set(x{[2..Length(x)]})));
####################################################################################

# (iv) the direct product of the disk with [0,1]
####################################################################################
# make a duplicate of the disk
    l0:=Length(bnd[1]);
    l1:=Length(bnd[2]); l1_:=Length(sub[2]);
    l2:=Length(bnd[3]); l2_:=Length(sub[3]);

    IsEdgeInDuplicate:=function(k)
        local x;

        if Length(Positions(bnd[2],bnd[2][k]))=2 and
            bnd[2][k]<>[2,l0+1,2*l0] then
                return true;
        elif not Position(bnd[2],bnd[2][k]-[0,l0,l0]) in sub[2] and
            not bnd[2][k]-[0,l0,l0] in [[2,1,2],[2,1,l0],[2,l0-1,l0]] then
                return true;
        else
            x:=List(
                List(crossings,y->y+l0),
                z->Length(Intersection(z,bnd[2][k]{[2,3]}))=2
            );
            if true in x then
                if IsBound(crs) then
                    if crs[Position(x,true)] in [1,-1] then
                        return true;
                    fi;   
                else
                    return true;
                fi;
            fi;                 
        fi;
        return false;
    end;

    loops:=Filtered(bnd[2]*1,x->Length(Positions(bnd[2],x))=2);
    loops:=Set(Concatenation(List(loops,x->x{[2,3]})));
    bnd[1]:=Concatenation(bnd[1],bnd[1]);
    sub[1]:=Concatenation(sub[1],[l0+2..2*l0-1]); 
# sub contains all duplicate 0-cells except for those in the frame... for now

    copy1:=List(bnd[2],x->x+[0,l0,l0]);
    bnd[2]:=Concatenation(bnd[2],copy1);
    for i in [l1+1..2*l1] do
        if IsEdgeInDuplicate(i) then
            Add(sub[2],i);
        fi;
    od;

    hbars2:=List(hbars,x->x+l0);
    vbars2:=List(vbars,x->x+l0);
    copy2:=List(bnd[3],x->Concatenation([x[1]],List(x{[2..Length(x)]},y->y+l1)));
    bnd[3]:=Concatenation(bnd[3],copy2);
    for i in [l2..2*l2] do
        cell:=bnd[3][i]*1;
        x:=[]; # all 0-cells in a given 2-cell
        for j in [2..Length(cell)] do
            for k in [2,3] do
                Add(x,bnd[2][cell[j]][k]);
            od;
        od;
        x:=Set(x);
        if Length(Intersection(cell{[2..cell[1]+1]},sub[2]))=cell[1] and
            (
                true in List(hbars2,y->IsSubset(y,x)) or
                true in List(vbars2,y->IsSubset(y,x))
            ) and
                cell[1]<>2 then
                    Add(sub[3],i);
        fi;
    od;
    l1__:=Length(sub[2]); l2__:=Length(sub[3]);

# 13-02-21 remove any path components of sub that consist of two 0-cells and two 1-cells only
    path_comp:=PathComponentsCWSubcomplex([RegularCWComplex(bnd),sub]);
    for i in [1..Length(path_comp)] do
        if Length(path_comp[i][2][1])=2 and
            Length(path_comp[i][2][2])=2 then
                for j in [1,2] do
                    sub[j]:=Difference(sub[j],path_comp[i][2][j]);
                od;
        fi;
    od;

# join the original disk to the copy
# each n-cell of the disk yields an (n+1)-cell which connects it
# to its duplicate
    for i in [1..l0] do
        Add(bnd[2],[2,i,i+l0]);
        if i in loops and
            i in sub[1] and
                i+l0 in sub[1] and
                    not i in [1,l0] then
                        Add(sub[2],Length(bnd[2]));
        fi;
    od;

    for i in [1..l1] do
        Add(
            bnd[3],
            [
                4,
                i,
                Position(bnd[2],[2,bnd[2][i][2],bnd[2][i+l1][2]]),
                Position(bnd[2],[2,bnd[2][i][3],bnd[2][i+l1][3]]),
                i+l1
            ]
        );
        if i in sub[2] and
            Length(Positions(bnd[2],bnd[2][i]))=2 and
                i+l1 in sub[2] then
                Add(sub[3],Length(bnd[3]));
        fi;       
    od;

    for i in [1..l2] do
        3cell:=[];
        # 13-02-21 plug the corner holes
            if bnd[3][i][1]=2 and
                bnd[3][i][2] in sub[2] and
                    not bnd[3][i][2]+l1 in sub[2] then
                        Add(sub[3],i);
            fi;
            if bnd[3][i][1]=2 and
                not bnd[3][i][2] in sub[2] and
                    bnd[3][i][2]+l1 in sub[2] then
                        Add(sub[3],i+l2);
            fi;
        for j in bnd[3][i]{[2..Length(bnd[3][i])]} do
            Add(
                3cell,
                Position(
                    bnd[3],
                    [
                        4,
                        j,
                        Position(bnd[2],[2,bnd[2][j][2],bnd[2][j+l1][2]]),
                        Position(bnd[2],[2,bnd[2][j][3],bnd[2][j+l1][3]]),
                        j+l1
                    ]
                )
            );
        od;
        Add(3cell,i);
        Add(3cell,i+l2);
        Add(bnd[4],Concatenation([bnd[3][i][1]+2],3cell));
    od;

    for i in [3,4] do
        bnd[i]:=List(bnd[i],x->Concatenation([x[1]],Set(x{[2..Length(x)]})));
    od;
####################################################################################

# (v) join the open ended 'pipes' at either end of B^2xI according to crs
####################################################################################
    colour:=List([1..4],x->[]);

    if not IsBound(crs) then
        crs:=List([1..Length(crossings)],x->1);
    fi;

# (a) start with the lower caps, they're more straight forward #####################
    lcap:=[];
    reg:=RegularCWComplex(bnd);
    for i in [1..l2] do
        if bnd[3][i][1]<>2 and not i in sub[3] then
            Add(lcap,i);
        elif bnd[3][i][1]=2 and not i in sub[3] then
            closure:=ClosureCWCell(reg,2,i);
            if not IsSubset(sub[2],closure[2][2]) then
                Add(lcap,i);
            fi;
        fi;
    od;

    pipes:=[]; # the 0,1 and 2-cells of each 'pipe' in the lower dome which will join
    # together to form the (intersecting) tubular surface
    for i in [1..l2] do
        if i in sub[3] then
            Add(
                pipes,
                [
                    [i],
                    bnd[3][i]{[2..bnd[3][i][1]+1]},
                    Set(
                        Concatenation(
                            List(
                                bnd[3][i]{[2..bnd[3][i][1]+1]},
                                x->bnd[2][x]{[2,3]}
                            )
                        )
                    )
                ]
            );
        fi;
    od;
    pipes:=Filtered(pipes,x->Length(x[3])>2);
    for i in [1..Length(pipes)] do
        for j in [i+1..Length(pipes)] do
            if Intersection(
                Intersection(
                    pipes[i][3],pipes[j][3]
                ),
                Concatenation(crossings)
            )<>[] then
                Append(pipes[i][1],pipes[j][1]);
                Append(pipes[i][2],pipes[j][2]);
                Append(pipes[i][3],pipes[j][3]);
                pipes[j][3]:=[];
            fi;
        od;
    od;
    Apply(pipes,x->[Set(x[1]),Set(x[2]), Set(x[3])]);
    pipes:=Filtered(pipes,x->x[3]<>[]);
    for i in [1..Length(pipes)] do # either end of each pipe has two 2-cells which
    # are currently absent from pipe[i][1], this step will add them
        for j in Filtered(bnd[3],x->x[1]=2) do
            int:=Intersection(pipes[i][2],j{[2,3]});
            if int<>[] then
                Add(pipes[i][1],Position(bnd[3],j));
            fi;
        od;
    od;
    for i in [1..Length(pipes)] do # if two pipes' 0-skeletons intersect, add a
        for j in [i+1..Length(pipes)] do # new 1-cell whose boundary is their intersection
            int:=Intersection(pipes[i][3],pipes[j][3]);
            if int<>[] then
                Add(int,2,1);
                Add(bnd[2],int);
                Add(sub[2],Length(bnd[2]));
            fi;
        od;
    od;
    for i in [1..Length(pipes)] do # replace the 1-cells that occur twice with
        for j in [1..Length(pipes[i][2])] do # either the new cell we just added or the
        # other occurance of that cell which is not in pipes[i][2]
            pos:=Positions(
                bnd[2],
                [
                    2,
                    bnd[2][pipes[i][2][j]][2],
                    bnd[2][pipes[i][2][j]][3]
                ]
            );
            if Length(pos)>=2 then
                cell:=Last(Filtered(pos,x->x<>pipes[i][2][j]));
                pipes[i][2][j]:=cell;
            fi;
        od;
    od;
    HorizontalOrVertical:=function(l)
        if l in hbars then
            return "horizontal";
        fi;
        return "vertical";
    end;
    for i in [1..Length(pipes)] do # if a pipe contains 1-cells from crossings then
        # filter out the horizontal/vertical 1-cells
        # should said pipe be vertical/horizontal itself
        if Intersection(pipes[i][3],Concatenation(crossings))<>[] then
            ori:=HorizontalOrVertical(pipes[i][3]);
            l:=Filtered(crossings,x->Intersection(x,pipes[i][3])<>[])[1];
            if ori="horizontal" then
                pipes[i][2]:=Difference(
                    pipes[i][2],
                    [
                        Position(bnd[2],[2,l[1],l[2]]),
                        Position(bnd[2],[2,l[3],l[4]])
                    ]
                );
            else
                pipes[i][2]:=Difference(
                    pipes[i][2],
                    [
                        Position(bnd[2],[2,l[1],l[3]]),
                        Position(bnd[2],[2,l[2],l[4]])
                    ]
                );
            fi;
        fi;
    od;
    for i in [1..Length(pipes)] do # add new 2-cells to bnd[3] whose boundary is
    # the pipes[i][2] 1-cells
        cell:=Set(pipes[i][2]);
        Add(cell,Length(cell),1);
        Add(bnd[3],cell);
        Add(sub[3],Length(bnd[3]));
        Add(lcap,Length(bnd[3]));
        Add(pipes[i][1],Length(bnd[3]));
    od;
    for i in [1..Length(pipes)] do # find where pipes intersect in their 2-skeleta
    # use this to form the 3-cells comprising the interiors of the pipes
        for j in [i+1..Length(pipes)] do
            if Intersection(pipes[i][1],pipes[j][1])<>[] then
                Append(pipes[i][1],pipes[j][1]);
                pipes[j][1]:=[];
            fi;
        od;
    od;
    for i in [1..Length(pipes)] do
        if pipes[i][1]<>[] then
            cell:=Set(pipes[i][1]);
            Add(cell,Length(cell),1);
            Add(bnd[4],cell);
        fi;
    od;

# (b) now for the upper caps, 0 in crs leads to a very elaborate CW-structure #######
# 13-02-21 this function was added to help alter the intersection structure below
# after discovering it was incorrect
    AboveBelow0Cell:=function(n,str)
        local n_, i, j, l;

        if n>l0 then
            n_:=n-l0;
        else
            n_:=n*1;
        fi;

        i:=Position(List(GRD,x->n_ in x),true);
        j:=Position(GRD[i],n_);
        
        if str="above" then
            l:=Reversed([1..i-1]);
        else
            l:=[i+1..Length(GRD)];
        fi;

        for k in l do
            if GRD[k][j]<>0 then
                if n>l0 then
                    return GRD[k][j]+l0;
                else
                    return GRD[k][j];
                fi;
            fi;
        od;
    end;
    
    ucap:=[];
    reg:=RegularCWComplex(bnd);
    for i in [l2+1..2*l2] do
        if bnd[3][i][1]<>2 and not i in sub[3] then
            Add(ucap,i);
        elif bnd[3][i][1]=2 and not i in sub[3] then
            closure:=ClosureCWCell(reg,2,i);
            if not IsSubset(sub[2],closure[2][2]) then
                Add(ucap,i);
            fi;
        fi;
    od;

    pipes:=[]; # the 0,1 and 2-cells of each 'pipe' in the upper dome which will join
    # together to form the (intersecting) tubular surface
    for i in [l2+1..2*l2] do
        if i in sub[3] then
            Add(
                pipes,
                [
                    [i],
                    bnd[3][i]{[2..bnd[3][i][1]+1]},
                    Set(
                        Concatenation(
                            List(
                                bnd[3][i]{[2..bnd[3][i][1]+1]},
                                x->bnd[2][x]{[2,3]}
                            )
                        )
                    )
                ]
            );
        fi;
    od;
    pipes:=Filtered(pipes,x->Length(x[3])>2);
    
    IntersectingCylinders:=function(a,b,c,d) ######################################
        local
            n, i, m, j, l, a_abv,
            b_abv, c_blw, d_blw,
            del_2_cell_1, del_2_cell_2,
            del_2_cell_1_i, del_2_cell_2_i,
            dif, f_clr, f_clr1, f_clr2;
# attaches to a 0 crossing some additional regular CW-structure
# to allow for a self-intersection to occur
        n:=1*Length(bnd[1])+1;
        for i in [1..8] do # 0-skeleton of intersection
            Add(bnd[1],[1,0]);
            Add(sub[1],Length(bnd[1]));
        od;
        # 1-skeleton of intersection
        m:=1*Length(bnd[2])+1;
        Add(bnd[2],[2,a,n]); Add(sub[2],Length(bnd[2])); # m
        Add(bnd[2],[2,b,n+1]); Add(sub[2],Length(bnd[2])); # m+1
        Add(bnd[2],[2,c,n+6]); Add(sub[2],Length(bnd[2])); # m+2
        Add(bnd[2],[2,d,n+7]); Add(sub[2],Length(bnd[2])); # m+3
        for i in [0..3] do
            for j in [1,2] do
                Add(bnd[2],[2,n+2*i,n+1+2*i]); # m+4, m+5, m+6, m+7, m+10, m+11, m+14, m+15
                # top first, then bottom (refer to drawing)
                Add(sub[2],Length(bnd[2]));
            od;
            if i>0 then
                Add(bnd[2],[2,n+2*i-2,n+2*i]); Add(sub[2],Length(bnd[2])); # m+8, m+12, m+16
                Add(bnd[2],[2,n+2*i-1,n+2*i+1]); Add(sub[2],Length(bnd[2])); # m+9, m+13, m+17
            fi;
        od;

        # 13-02-21 need to remove cells from sub to accommodate the
        # new self-intersection structure
        a_abv:=AboveBelow0Cell(a,"above");
        b_abv:=AboveBelow0Cell(b,"above");
        c_blw:=AboveBelow0Cell(c,"below");
        d_blw:=AboveBelow0Cell(d,"below");
        del_2_cell_1:=[
            Position(bnd[2],[2,a_abv,a]),
            Position(bnd[2],[2,b_abv,b]),
            Position(bnd[2],[2,a,b])
        ];
        del_2_cell_1_i:=Position(
            List(
                bnd[3],
                x->Length(
                    Intersection(
                        x{[2..x[1]+1]},
                        del_2_cell_1
                    )
                )=3
            ),
            true
        );
        del_2_cell_2:=[
            Position(bnd[2],[2,c,c_blw]),
            Position(bnd[2],[2,d,d_blw]),
            Position(bnd[2],[2,c,d])
        ];
        del_2_cell_2_i:=Position(
            List(
                bnd[3],
                x->Length(
                    Intersection(
                        x{[2..x[1]+1]},
                        del_2_cell_2
                    )
                )=3
            ),
            true
        );
        sub[3]:=Difference(sub[3],[del_2_cell_1_i,del_2_cell_2_i]);
        sub[2]:=Difference(
            sub[2],
            [
                Position(bnd[2],[2,a_abv,a]),
                Position(bnd[2],[2,b_abv,b]),
                Position(bnd[2],[2,c,c_blw]),
                Position(bnd[2],[2,d,d_blw])
            ]
        );

        # 14-02-21 this new structure has 4 additional 1-cells
        Add(bnd[2],[2,a_abv,n]); Add(sub[2],Length(bnd[2])); # m+18
        Add(bnd[2],[2,b_abv,n+1]); Add(sub[2],Length(bnd[2])); # m+19
        Add(bnd[2],[2,n+6,c_blw]); Add(sub[2],Length(bnd[2])); # m+20
        Add(bnd[2],[2,n+7,d_blw]); Add(sub[2],Length(bnd[2])); # m+21

        # 2-skeleton of intersection
        l:=1*Length(bnd[3])+1;
        Add( # l
            bnd[3],
            [
                4,
                Position(bnd[2],[2,a,b]),
                m,
                m+1,
                m+5
            ]
        );
        Add(sub[3],Length(bnd[3]));
        Add( # l+1
            bnd[3],
            [
                4,
                Position(bnd[2],[2,c,d]),
                m+2,
                m+3,
                m+15
            ]
        );
        Add(sub[3],Length(bnd[3]));
        # these 2-cells are those which should be coloured #########################
        if IsBound(clr) then                                                      ##
            pos:=Position(List(crossings,x->Set(x)+l0),Set([a,b,c,d]));           ##
            pos:=pos-Length(Filtered(crs{[1..pos-1]},x->x<>0));                   ##
        fi;                                                                       ##
        Add(bnd[3],[4,m+4,m+6,m+8,m+9]); # l+2                                    ##
        Add(sub[3],Length(bnd[3]));                                               ##              
        Add(bnd[3],[4,m+5,m+7,m+8,m+9]); # l+3                                    ##
        Add(sub[3],Length(bnd[3]));                                               ## 
        for i in [0,1] do                                                         ##
            Add(bnd[3],[4,m+6+4*i,m+10+4*i,m+12+4*i,m+13+4*i]); # l+4, l+6        ##  
            Add(sub[3],Length(bnd[3]));                                           ##
            Add(bnd[3],[4,m+7+4*i,m+11+4*i,m+12+4*i,m+13+4*i]); # l+5, l+7        ##
            Add(sub[3],Length(bnd[3]));                                           ##
        od;                                                                       ##
        if IsBound(clr) then                                                      ##
            if clr[pos]=1 then                                                    ##
                colour[3][Length(bnd[3])-5]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])-4]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])-1]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])]:=[-1]; # blue                           ##
            elif clr[pos]=2 then                                                  ##
                colour[3][Length(bnd[3])-5]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])-4]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])-1]:=[1]; # red                           ##
                colour[3][Length(bnd[3])]:=[1]; # red                             ##
            elif clr[pos]=3 then                                                  ##
                colour[3][Length(bnd[3])-5]:=[1]; # red                           ##
                colour[3][Length(bnd[3])-4]:=[1]; # red                           ##
                colour[3][Length(bnd[3])-1]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])]:=[-1]; # blue                           ##
            else                                                                  ##
                colour[3][Length(bnd[3])-5]:=[1]; # red                           ##
                colour[3][Length(bnd[3])-4]:=[1]; # red                           ##
                colour[3][Length(bnd[3])-1]:=[1]; # red                           ##
                colour[3][Length(bnd[3])]:=[1]; # red                             ##
            fi;                                                                   ##
        fi;                                                                       ##
        # 14-02-21 there are four more 2-cells                                    ##
        dif:=Difference(bnd[3][del_2_cell_1_i]{[2..5]},del_2_cell_1)[1];          ##
        Add( # l+8 bottom                                                         ##
            bnd[3],                                                               ##
            [                                                                     ##
                4,                                                                ##
                dif,                                                              ##
                m+5,                                                              ##
                m+18,                                                             ##
                m+19                                                              ##
            ]                                                                     ##
        );                                                                        ##
        Add(sub[3],Length(bnd[3]));                                               ##
        dif:=Difference(bnd[3][del_2_cell_2_i]{[2..5]},del_2_cell_2)[1];          ##
        Add( # l+9 bottom                                                         ##
            bnd[3],                                                               ##
            [                                                                     ##
                4,                                                                ##
                dif,                                                              ##
                m+15,                                                             ##
                m+20,                                                             ##
                m+21                                                              ##
            ]                                                                     ##
        );                                                                        ##
        Add(sub[3],Length(bnd[3]));                                               ##
        if IsBound(clr) then                                                      ##
            if clr[pos]=1 then                                                    ##
                colour[3][Length(bnd[3])-1]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])]:=[-1]; # blue                           ##
            elif clr[pos]=2 then                                                  ##
                colour[3][Length(bnd[3])-1]:=[-1]; # blue                         ##
                colour[3][Length(bnd[3])]:=[1]; # red                             ##
            elif clr[pos]=3 then                                                  ##
                colour[3][Length(bnd[3])-1]:=[1]; # red                           ##
                colour[3][Length(bnd[3])]:=[-1]; # blue                           ##
            else                                                                  ##
                colour[3][Length(bnd[3])-1]:=[1]; # red                           ##
                colour[3][Length(bnd[3])]:=[1]; # red                             ##
            fi;                                                                   ##
        fi;                                                                       ##
        ############################################################################
        Add(bnd[3],[2,m+4,m+5]); # l+10
        Add(sub[3],Length(bnd[3]));
        Add(bnd[3],[2,m+14,m+15]); # l+11
        Add(sub[3],Length(bnd[3]));
        # from this point onwards, cells added are only present in bnd, not sub
        Add( # l+12
            bnd[3],
            [
                6,
                Position(bnd[2],[2,a,c]),
                m,
                m+2,
                m+8,
                m+12,
                m+16
            ]
        );
        Add( # l+13
            bnd[3],
            [
                6,
                Position(bnd[2],[2,b,d]),
                m+1,
                m+3,
                m+9,
                m+13,
                m+17
            ]
        );
        # 14-02-21 another few 2-cells to bnd only
        Add( # l+14
            bnd[3],
            [
                3,
                Position(bnd[2],[2,a_abv,a]),
                m,
                m+18
            ]
        );
        Add( # l+15
            bnd[3],
            [
                3,
                Position(bnd[2],[2,b_abv,b]),
                m+1,
                m+19
            ]
        );
        Add( # l+16
            bnd[3],
            [
                3,
                Position(bnd[2],[2,c,c_blw]),
                m+2,
                m+20
            ]
        );
        Add( # l+17
            bnd[3],
            [
                3,
                Position(bnd[2],[2,d,d_blw]),
                m+3,
                m+21
            ]
        );
        # 19/04/21 found some 2-cells missing from ucap causing the chain complex
        # boundary matrices to detect that this wasn't a regular cw-complex
        for i in [0..3] do Add(ucap,l+14+i); od; 
        # 3-skeleton of intersection
        Add(
            bnd[4],
            [
                8,
                l+2,
                l+3,
                l+4,
                l+5,
                l+6,
                l+7,
                l+10,
                l+11
            ]
        );
        Add(
            bnd[4],
            [
                8,
                Position(
                    List(bnd[3],Set),
                    Set(
                        [
                            4,
                            Position(bnd[2],[2,a,b]),
                            Position(bnd[2],[2,c,d]),
                            Position(bnd[2],[2,a,c]),
                            Position(bnd[2],[2,b,d])
                        ]
                    )
                ),
                l,
                l+1,
                l+3,
                l+5,
                l+7,
                l+12,
                l+13
            ]
        );
        # 14-02-21 need two more 3-cells to finish off the structure
        Add(
            bnd[4],
            [
                5,
                del_2_cell_1_i,
                l,
                l+8,
                l+14,
                l+15
            ]
        );
        Add(
            bnd[4],
            [
                5,
                del_2_cell_2_i,
                l+1,
                l+9,
                l+16,
                l+17
            ]
        );

        if IsBound(clr) then
            f_clr:=clr[pos]*1;
            if f_clr=1 then
                f_clr1:=-1;
                f_clr2:=-1;
            elif f_clr=2 then
                f_clr1:=-1;
                f_clr2:=1;
            elif f_clr=3 then
                f_clr1:=1;
                f_clr2:=-1;
            else
                f_clr1:=1;
                f_clr2:=1;
            fi;
        else
            f_clr1:=0;
            f_clr2:=0;
        fi;

        for i in [1..Length(pipes)] do
            if IsBound(pipes[i][1][1]) then
                if pipes[i][1][1]=del_2_cell_1_i then
                    pipes[i]:=[
                        [
                            Position(
                                bnd[3],
                                Concatenation(
                                    [2],
                                    Set(
                                        Positions(
                                            bnd[2],
                                            Concatenation(
                                                [2],
                                                Set(
                                                    [a_abv,b_abv]
                                                )
                                            )
                                        )
                                    )
                                )
                            ),
                            l+8,
                            l+10
                        ],
                        [
                            Filtered(
                                pipes[i][2],
                                x->Length(
                                    Positions(
                                        bnd[2],
                                        bnd[2][x]
                                    )
                                )=2
                            )[1],
                            m+4,
                            m+18,
                            m+19
                        ],
                        [
                            a_abv,
                            b_abv,
                            n,
                            n+1
                        ],
                        '*', # just to mark this pipe as the vertical part of an intersection
                        f_clr1
                    ];
                elif pipes[i][1][1]=del_2_cell_2_i then
                    pipes[i]:=[
                        [
                            Position(
                                bnd[3],
                                Concatenation(
                                    [2],
                                    Set(
                                        Positions(
                                            bnd[2],
                                            Concatenation(
                                                [2],
                                                Set(
                                                    [c_blw,d_blw]
                                                )
                                            )
                                        )
                                    )
                                )
                            ),
                            l+9,
                            l+11
                        ],
                        [
                            Filtered(
                                pipes[i][2],
                                x->Length(
                                    Positions(
                                        bnd[2],
                                        bnd[2][x]
                                    )
                                )=2
                            )[1],
                            m+14,
                            m+20,
                            m+21
                        ],
                        [
                            c_blw,
                            d_blw,
                            n+6,
                            n+7
                        ],
                        '*',
                        f_clr2
                    ];
                fi;
            fi;
        od;
        for i in [1..Length(pipes)] do
            if not IsBound(pipes[i][4]) then
                int:=Set(
                    Intersection(
                        pipes[i][3],
                        [a,b,c,d]
                    )
                );
                if Length(int)=4 then
                    if crs[Position(List(crossings+l0,Set),int)]=0 then
                        pipes[i]:=[
                            [
                                l+2,
                                l+4,
                                l+6,
                                l+12,
                                l+13
                            ],
                            [
                                m,
                                m+1,
                                m+2,
                                m+3,
                                m+4,
                                m+14
                            ],
                            [
                                a,
                                b,
                                c,
                                d,
                                n,
                                n+1,
                                n+6,
                                n+7
                            ],
                        ];
                    fi;
                fi;
            fi;
        od;
    end; ##########################################################################

    for i in [1..Length(crs)] do
        if crs[i]=0 then
            IntersectingCylinders(
                crossings[i][1]+l0,
                crossings[i][3]+l0,
                crossings[i][2]+l0,
                crossings[i][4]+l0
            );
        fi;
    od;
    for i in [1..Length(pipes)] do # ignoring all self-intersections, join all
    # pipes which intersect at a common crossing point
        for j in [i+1..Length(pipes)] do
            if not IsBound(pipes[i][4]) and not IsBound(pipes[j][4]) then
                int:=Intersection(pipes[i][3],pipes[j][3]);
                if Length(int)>=2 and Intersection(int,Concatenation(crossings)+l0)=int then
                    Append(pipes[i][1],pipes[j][1]);
                    pipes[i][1]:=Set(pipes[i][1]); pipes[j][1]:=[];
                    Append(pipes[i][2],pipes[j][2]);
                    pipes[i][2]:=Set(pipes[i][2]); pipes[j][2]:=[];
                    Append(pipes[i][3],pipes[j][3]);
                    pipes[i][3]:=Set(pipes[i][3]); pipes[j][3]:=[];
                fi;
            fi;
        od;
    od;
    pipes:=Filtered(pipes,x->x<>[[],[],[]]);
    for i in [1..Length(pipes)] do # add the degree two 2-cells to the ends of each pipe
    # except for the vertical pipes at each intersection (they already have them)
        if not IsBound(pipes[i][4]) then
            for j in Filtered(bnd[3]{[l2+1..2*l2]},x->x[1]=2) do
                int:=Intersection(pipes[i][2],j{[2,3]});
                if int<>[] then
                    Add(pipes[i][1],Position(bnd[3],j));
                fi;
            od;
        fi;
    od;
    for i in [1..Length(pipes)] do # if two pipes' 0-skeletons intersect (at somewhere other
    # than a crossing), add a new 1-cell whose boundary is their intersection
        for j in [i+1..Length(pipes)] do
            int:=Intersection(pipes[i][3],pipes[j][3]);
            if int<>[] then
                if Intersection(int,Concatenation(crossings)+l0)=[] and
                    int<[2*l0,2*l0] then
                        Add(int,2,1);
                        Add(bnd[2],int);
                        Add(sub[2],Length(bnd[2]));
                fi;
            fi;
        od;
    od;
    for i in [1..Length(pipes)] do # replace the 1-cells (added pre IntersectingCylinders)
    # that occur twice with either the new cell we just added or the other occurance of
        for j in [1..Length(pipes[i][2])] do # that cell which is not in pipes[i][2]
            pos:=Positions(
                bnd[2],
                [
                    2,
                    bnd[2][pipes[i][2][j]][2],
                    bnd[2][pipes[i][2][j]][3]
                ]
            );
            if Length(pos)>=2 and
                [
                    bnd[2][pipes[i][2][j]][2],
                    bnd[2][pipes[i][2][j]][3]
                ]<[2*l0,2*l0] then
                    cell:=Last(Filtered(pos,x->x<>pipes[i][2][j]));
                    pipes[i][2][j]:=cell;
            fi;
        od;
    od;
    HorizontalOrVertical:=function(l)
        if l in hbars+l0 then
            return "horizontal";
        fi;
        return "vertical";
    end;
    for i in [1..Length(pipes)] do # if a pipe contains 1-cells from crossings then
        # filter out the horizontal/vertical 1-cells
        # should said pipe be vertical/horizontal itself
        # however if a pipe contains a self intersection remove both the horizontal
        # AND vertical 1-cells
        int:=Intersection(pipes[i][3],Concatenation(crossings)+l0);
        if Length(int)=4 then
            pos:=Position(List(crossings,Set)+l0,Set(int));
            if crs[pos]=0 then
                pipes[i][2]:=Difference(
                    pipes[i][2],
                    [
                        Position(bnd[2],[2,crossings[pos][1]+l0,crossings[pos][2]+l0]),
                        Position(bnd[2],[2,crossings[pos][3]+l0,crossings[pos][4]+l0]),
                        Position(bnd[2],[2,crossings[pos][1]+l0,crossings[pos][3]+l0]),
                        Position(bnd[2],[2,crossings[pos][2]+l0,crossings[pos][4]+l0])
                    ]
                );
            else
                ori:=HorizontalOrVertical(pipes[i][3]);
                if ori="horizontal" then
                    pipes[i][2]:=Difference(
                    pipes[i][2],
                    [
                        Position(bnd[2],[2,crossings[pos][1]+l0,crossings[pos][2]+l0]),
                        Position(bnd[2],[2,crossings[pos][3]+l0,crossings[pos][4]+l0]),
                    ]
                );
                else
                    pipes[i][2]:=Difference(
                    pipes[i][2],
                    [
                        Position(bnd[2],[2,crossings[pos][1]+l0,crossings[pos][3]+l0]),
                        Position(bnd[2],[2,crossings[pos][2]+l0,crossings[pos][4]+l0])
                    ]
                );
                fi;
            fi;
        fi;
    od;
    for i in [1..Length(pipes)] do # add new 2-cells to bnd[3] whose boundary is
    # the pipes[i][2] 1-cells
        cell:=Set(pipes[i][2]);
        Add(cell,Length(cell),1);
        Add(bnd[3],cell);
        Add(sub[3],Length(bnd[3]));
        Add(ucap,Length(bnd[3]));
        Add(pipes[i][1],Length(bnd[3]));
        if IsBound(pipes[i][5]) then
            if IsBound(clr) then
                colour[3][Length(bnd[3])]:=[pipes[i][5]];
            fi;
        fi;
    od;
    for i in [1..Length(pipes)] do # find where pipes intersect in their 2-skeleta
    # use this to form the 3-cells comprising the interiors of the pipes
        for j in [i+1..Length(pipes)] do
            if Intersection(pipes[i][1],pipes[j][1])<>[] then
                Append(pipes[i][1],pipes[j][1]);
                pipes[j][1]:=[];
            fi;
        od;
    od;
    for i in [1..Length(pipes)] do
        if pipes[i][1]<>[] then
            cell:=Set(pipes[i][1]);
            Add(cell,Length(cell),1);
            Add(bnd[4],cell);
        fi;
    od;
###################################################################################

# add a cap to both ends of D x [0,1] 
####################################################################################
    Add(
        bnd[3],
        [
            2,
            Positions(bnd[2],[2,1,l0])[1],
            Positions(bnd[2],[2,1,l0])[2]
        ]
    );
    Add(lcap,Length(bnd[3]));
    lcap:=Set(lcap);
    Add(lcap,Length(lcap),1);
    Add(bnd[4],lcap);
    Add(
        bnd[3],
        [
            2,
            Positions(bnd[2],[2,l0+1,2*l0])[1],
            Positions(bnd[2],[2,l0+1,2*l0])[2]
        ]
    );
    Add(ucap,Length(bnd[3]));
    ucap:=Set(ucap);
    Add(ucap,Length(ucap),1);
    Add(bnd[4],ucap);
####################################################################################

# add colour
####################################################################################
    for i in [1..Length(bnd[3])] do
        if not IsBound(colour[3][i]) then
            colour[3][i]:=[0];
        fi;
    od;
    colour_:={n,k}->colour[n+1][k];
####################################################################################
    x:=CWSubcomplexToRegularCWMap([RegularCWComplex(bnd),sub]);
    x!.colour:=colour_;
    return x;
end);