Add ToddCoxeterBand method

doc/freeband.xml

@@ -190,3 +190,23 @@ gap> ContentOfFreeBandElementCollection([x, y]);
     </Description>
   </ManSection>
 <#/GAPDoc>
+
+<#GAPDoc Label="ToddCoxeterBand">
+  <ManSection>
+    <Oper Name="ToddCoxeterBand"  Arg="n, R"/>
+    <Description>
+      This operation takes band presentation, where <A>n</A> is the size
+      of alphabet <C>A = [1 .. n]</C> and <A>R</A> is a list of lists of
+      words over <C>A</C>, representing the relations. It computes the
+      band defined by this band presentation via a band-specific version
+      of the Todd-Coxeter algorithm. If <A>R</A> is the empty list, then
+      the free band over <C>A</C> is computed.
+
+      <!--
+      TODO: I think we should write a little more about the algorithm here
+      once we've finalised it. We should also add some examples, once we've
+      decided on exactly what the output should be.
+      -->
+    </Description>
+  </ManSection>
+<#/GAPDoc>

doc/z-chap10.xml

@@ -154,6 +154,7 @@ x1x2x2^-1x1^-1x1x2]]></Example>
     <#Include Label = "IsFreeBandElementCollection">
     <#Include Label = "IsFreeBandSubsemigroup">
     <#Include Label = "ContentOfFreeBandElement">
+    <#Include Label = "ToddCoxeterBand">
 
   </Section>
 

gap/fp/freeband.gd

@@ -18,3 +18,5 @@ DeclareGlobalFunction("FreeBand");
 DeclareAttribute("ContentOfFreeBandElement", IsFreeBandElement);
 DeclareAttribute("ContentOfFreeBandElementCollection",
                  IsFreeBandElementCollection);
+
+DeclareOperation("ToddCoxeterBand", [IsPosInt, IsList]);

gap/fp/freeband.gi

@@ -550,3 +550,186 @@ function(x, hashlen)
   return rec(func := SEMIGROUPS.HashFunctionForFreeBandElements,
              data := hashlen);
 end);
+
+InstallMethod(ToddCoxeterBand, "for a pos int and list of lists of words",
+[IsPosInt, IsList],
+function(N, R)
+  local new_coset, tauf, canon, push_relation, process_coincidences,
+  A, F, G, k, active_cosets, table, coincidences, words, n, word,
+  pair, char, coset;
+
+  for pair in R do
+    if not IsList(pair) then
+      ErrorNoReturn("expected a list of lists as second argument");
+    elif Length(pair) <> 2 then
+      ErrorNoReturn("expected a list of lists with length 2 as second argument");
+    fi;
+    for word in pair do
+      for n in word do
+        if n < 1 or n > N then
+          ErrorNoReturn("expected a list of lists containing 2 words over ",
+                        "[1 .. N] as second argument");
+        fi;
+      od;
+    od;
+  od;
+
+  new_coset := function(coset, char)
+    local new_word, pos;
+    # new_coset for bands is smart. If the word created, once reduced,
+    # is already somewhere else in the list, then it just sets
+    # table[coset][char] to be that coset.
+    if table[coset][char] = 0 then
+      new_word := canon(Concatenation(words[coset], [char]));
+      pos      := Position(words, new_word);
+
+      if pos = fail then
+        # in this case the word is genuinely new and we make a new coset
+        table[coset][char] := k;
+        active_cosets[k]   := true;
+        Add(table, ListWithIdenticalEntries(Length(A), 0));
+        Add(words, new_word);
+        k := k + 1;
+
+      else
+        # word already exists
+        table[coset][char] := pos;
+
+      fi;
+    fi;
+  end;
+
+  tauf := function(coset, word)
+    local char;
+    # forced tau. This creates new cosets as necessary.
+    if Length(word) = 0 then
+      return coset;
+    fi;
+    for char in word do
+      if table[coset][char] = 0 then
+        # if the product is undefined, define it, and start coset back up
+        # at the newly defined value (k-1).
+        new_coset(coset, char);
+      fi;
+      coset := table[coset][char];
+    od;
+    return coset;
+  end;
+
+  canon := function(word)
+    # expresses a word in free band-canonical form.
+    if IsEmpty(word) then
+      return [];
+    fi;
+    return SEMIGROUPS.FreeBandElmToWord(EvaluateWord(G, word));
+  end;
+
+  push_relation := function(coset, u, v)
+    local ut, vt;
+    ut := tauf(coset, u);
+    vt := tauf(coset, v);
+    if ut <> vt then
+      Add(coincidences, [ut, vt]);
+    fi;
+  end;
+
+  process_coincidences := function()
+    # changed to depth-first.
+    local i, j, char, coset, pair, current, counter;
+    if Length(coincidences) = 0 then
+      return;
+    fi;
+    while Length(coincidences) <> 0 do
+      # current := Length(coincidences);
+      current := 1;
+      i       := Minimum(coincidences[current]);
+      j       := Maximum(coincidences[current]);
+      if i = j then
+      fi;
+      counter := 0;
+      if i <> j then
+        for char in A do
+          if table[j][char] <> 0 then
+            if table[i][char] = 0 then
+              table[i][char] := table[j][char];
+            elif table[i][char] <> 0 then
+              counter := counter + 1;
+              Add(coincidences, [table[i][char], table[j][char]]);
+            fi;
+          fi;
+        od;
+        # for coset in ListBlist([1 .. k - 1], active_cosets) do
+        for coset in [1 .. k - 1] do
+          for char in A do
+            if table[coset][char] = j then
+              table[coset][char] := i;
+            fi;
+          od;
+        od;
+        for pair in coincidences do
+          if pair[1] = j then
+            pair[1] := i;
+          fi;
+          if pair[2] = j then
+            pair[2] := i;
+          fi;
+        od;
+        active_cosets[j] := false;
+      fi;
+      Remove(coincidences, current);
+      # Unbind(parents[j]);
+      # Unbind(edges[j]);
+    od;
+  end;
+
+  A             := [1 .. N];
+  F             := FreeBand(N);
+  G             := GeneratorsOfSemigroup(F);
+  k             := 2;
+  active_cosets := [true];
+  table         := [[]];
+  coincidences  := [];
+  words         := [[]];
+  for char in A do
+    table[1][char] := 0;
+  od;
+  n := 0;
+  repeat
+
+    n  := n + 1;
+
+    # only do anything if the current coset is active
+    if active_cosets[n] then
+
+      # populate the current line of the table with new cosets if need be
+      for char in A do
+        new_coset(n, char);
+      od;
+
+      # push the coset n through every explicit relation
+      for pair in R do
+        push_relation(n, pair[1], pair[2]);
+      od;
+
+      # push the current coset through every known implicit relation
+      for word in ListBlist(words, active_cosets) do
+        pair := [Concatenation(word, word), word];
+        push_relation(n, pair[1], pair[2]);  # word is already canonical
+      od;
+
+    fi;
+
+    process_coincidences();
+
+  until n = k - 1;
+
+  for pair in R do
+    if Length(pair[1]) = 0 or Length(pair[2]) = 0 then
+      # then one of these must be a monoid presentation.
+      return Length(ListBlist([1 .. k - 1], active_cosets));
+    fi;
+  od;
+
+  # if no relations have the empty word then this is not a monoid presentation.
+  return Length(ListBlist([1 .. k - 1], active_cosets)) - 1;
+end);