diff --git a/doc/freeband.xml b/doc/freeband.xml index 5b647990a..a968048cd 100644 --- a/doc/freeband.xml +++ b/doc/freeband.xml @@ -190,3 +190,23 @@ gap> ContentOfFreeBandElementCollection([x, y]); <#/GAPDoc> + +<#GAPDoc Label="ToddCoxeterBand"> + + + + This operation takes band presentation, where n is the size + of alphabet A = [1 .. n] and R is a list of lists of + words over A, representing the relations. It computes the + band defined by this band presentation via a band-specific version + of the Todd-Coxeter algorithm. If R is the empty list, then + the free band over A is computed. + + + + +<#/GAPDoc> diff --git a/doc/z-chap10.xml b/doc/z-chap10.xml index 6cd689f03..a4b41f757 100644 --- a/doc/z-chap10.xml +++ b/doc/z-chap10.xml @@ -154,6 +154,7 @@ x1x2x2^-1x1^-1x1x2]]> <#Include Label = "IsFreeBandElementCollection"> <#Include Label = "IsFreeBandSubsemigroup"> <#Include Label = "ContentOfFreeBandElement"> + <#Include Label = "ToddCoxeterBand"> diff --git a/gap/fp/freeband.gd b/gap/fp/freeband.gd index d60085d0b..aa907931b 100644 --- a/gap/fp/freeband.gd +++ b/gap/fp/freeband.gd @@ -18,3 +18,5 @@ DeclareGlobalFunction("FreeBand"); DeclareAttribute("ContentOfFreeBandElement", IsFreeBandElement); DeclareAttribute("ContentOfFreeBandElementCollection", IsFreeBandElementCollection); + +DeclareOperation("ToddCoxeterBand", [IsPosInt, IsList]); diff --git a/gap/fp/freeband.gi b/gap/fp/freeband.gi index d507e0a8b..4be728435 100644 --- a/gap/fp/freeband.gi +++ b/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);