# Grammar models for the various knot tying grammars used in
# Hirsch, Markström, Patterson, Sandberg, Vejdemo-Johansson
#

with(combstruct);

# The grammar describing the original Fink and Mao tie knots.
FinkMao := {
tie = Prod(L, iL),
iL = Union(Prod(R, iR), Prod(C, iC), Prod(R, C)),
iR = Union(Prod(L, iL), Prod(C, iC), Prod(L, C)),
iC = Union(Prod(L, iL), Prod(R, iR)),
L=Atom, R=Atom, C=Atom};

# The grammar describing all tie knots, using the R/L/C notation.
RLCtie := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), Prod(L, C, U, iC), Prod(L, C, U),
    Prod(C,L,iL), Prod(C, L, U, iL), Prod(C, L, U)),
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), Prod(R, C, U, iC), Prod(R, C, U),
    Prod(C,R,iR), Prod(C, R, U, iR), Prod(C, R, U)),
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), Prod(L, R, U, iR), Prod(L, R, U),
    Prod(R,L,iL), Prod(R, L, U, iL), Prod(R, L, U)),
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing R-final tie knots, using the R/L/C notation.
RLCtieR := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), Prod(L, C, U, iC), 
    Prod(C,L,iL), Prod(C, L, U, iL)), 
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), Prod(R, C, U, iC), 
    Prod(C,R,iR), Prod(C, R, U, iR), Prod(C, R, U)),
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), Prod(L, R, U, iR), Prod(L, R, U),
    Prod(R,L,iL), Prod(R, L, U, iL)), 
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing L-final tie knots, using the R/L/C notation.
RLCtieL := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), Prod(L, C, U, iC), 
    Prod(C,L,iL), Prod(C, L, U, iL), Prod(C, L, U)),
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), Prod(R, C, U, iC), 
    Prod(C,R,iR), Prod(C, R, U, iR)), 
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), Prod(L, R, U, iR), 
    Prod(R,L,iL), Prod(R, L, U, iL), Prod(R, L, U)),
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing C-final tie knots, using the R/L/C notation.
RLCtieC := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), Prod(L, C, U, iC), Prod(L, C, U),
    Prod(C,L,iL), Prod(C, L, U, iL)), 
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), Prod(R, C, U, iC), Prod(R, C, U),
    Prod(C,R,iR), Prod(C, R, U, iR)), 
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), Prod(L, R, U, iR), 
    Prod(R,L,iL), Prod(R, L, U, iL)), 
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing all windings, using the R/L/C notation.
RLCtienoU := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), Prod(L, C),
    Prod(C,L,iL), Prod(C, L)),
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), Prod(R, C),
    Prod(C,R,iR), Prod(C, R)),
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), Prod(L, R),
    Prod(R,L,iL), Prod(R, L)),
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing R-final windings, using the R/L/C notation.
RLCtieRnoU := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), 
    Prod(C,L,iL)), 
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), 
    Prod(C,R,iR), Prod(C, R)),
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), Prod(L, R),
    Prod(R,L,iL)), 
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing L-final windings, using the R/L/C notation.
RLCtieLnoU := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), 
    Prod(C,L,iL), Prod(C, L)),
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), 
    Prod(C,R,iR)), 
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), 
    Prod(R,L,iL), Prod(R, L)),
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};

# The grammar describing C-final windings, using the R/L/C notation.
RLCtieCnoU := {
  iR = Union(Prod(L,R,iR), Prod(C,R,iR),
    Prod(L,C,iC), Prod(L, C),
    Prod(C,L,iL)), 
  iL = Union(Prod(R,L,iL), Prod(C,L,iL),
    Prod(R,C,iC), Prod(R, C),
    Prod(C,R,iR)), 
  iC = Union(Prod(L,C,iC), Prod(R,C,iC),
    Prod(L,R,iR), 
    Prod(R,L,iL)), 
  tie=Prod(L, Union(iL, Prod(R, iR), Prod(C, iC))),
  R=Atom, L=Atom, C=Atom, U=Epsilon
};


# The grammar describing all knots, using the TW notation.
TWtie := {
prefix = Union(T, W, Epsilon),
tuck = Union(Prod(T, T, U), Prod(W, W, U)),
pair = Union(Prod(T, T), Prod(T, W), Prod(W, T), Prod(W, W)),
tie = Prod(prefix, Sequence(Union(tuck, pair)), tuck),
T=Atom, W=Atom, U=Epsilon
};

# The grammar describing all knots, including back-tucked knots,
# using the TW notation.
TWtieBack := {
iT = Union(Prod(T,iT), Prod(T,U,iT), Prod(T,U), Prod(W,iW)),
iW = Union(Prod(W,iW), Prod(W,U,iW), Prod(W,U), Prod(T,iT)),
tie = Union(Prod(T,iT),Prod(W,iW)),
T=Atom, W=Atom, U=Epsilon
};


# The grammar describing tie knots of all tuck depths
# We use II to denote the symbol '
TWrecursive := {
  tie = Prod(prefix, Sequence(Union(tuck,pair)), tuck),
  prefix = Union(T, W, Epsilon),
  pair = Prod(Union(T, W), Union(T, W)),
  tuck = Union(ttuck2, wtuck2),
  ttuck2 = Union(Prod(T, T, w0, U),
                 Prod(T, W, w1, U)),
  wtuck2 = Union(Prod(W, W, w0, U),
                 Prod(W, T, w2, U)),
  w0 = Union(Prod(W, W, w1, U), Prod(W, T, w0, U),
             Prod(T, W, w0, U), Prod(T, T, w2, U),
             Prod(ttuck2, II, w2, U), Prod(wtuck2, II, w1, U), 
             Epsilon),
  w1 = Union(Prod(W, W, w2, U), Prod(W, T, w1, U),
             Prod(T, W, w1, U), Prod(T, T, w0, U),
             Prod(ttuck2, II, w0, U), Prod(wtuck2, II, w2, U)),
  w2 = Union(Prod(W, W, w0, U), Prod(W, T, w2, U),
             Prod(T, W, w2, U), Prod(T, T, w1, U),
             Prod(ttuck2, II, w1, U), Prod(wtuck2, II, w0, U)),
  T=Atom, W=Atom, U=Epsilon, II=Epsilon
};