1#############################################################################
2##
3#A  rws4.g                  GAP library                  Derek Holt
4##
5##  This file contains those functions that deal with rewriting systems.
6##
7##  1.3.00. created this file from GAP3 version rws.g and started adapting
8##  it to GAP4.
9##
10##  1.8.96.
11##  Changed the ReorderGenerators command to permute the alphabet
12##  themselves, and deleted the generatorOrder field. This avoids the
13##  need of permuting columns of fsa's when updating.
14##
15##  15.3.95.
16##  Each (internal) rewriting-system now has components "GpMonSgp" (for the
17##  associated group or monoid), "generators" (for the generators, which
18##  will include those of GpMonSgp, but may also include inverses
19##  in the group case), and "namesGenerators", which again include
20##  those of GpMonSgp, but will have names with "^-1" adjoined for inverses.
21##
22##  When an externally created file containing a rewriting-system is read in
23##  to GAP, a preprocessing external program called "ppgap" is run, which
24##  creates a file called "file.gap", which includes necessary declarations
25##  of a suitable underlying monoid.
26##
27##  23.2.95. The internal storage of a rewriting system was changed so
28##  that generators are simply numbers in the range [1..ng] for some ng,
29##  and words are lists of generator numbers.
30##
31DeclareInfoClass("InfoRWS");
32
33
34#############################################################################
35#V  _RWS                external variable - the name of the rewriting system
36#V  _RWS_Sub            external variable - subgroup of the rewriting system
37#V  _RWS_Cos            external variable - coset rewriting system
38#V  _RWS.GpMonSgp 	external variable - name of underlying group or monoid
39#V  _RWS.FreeGpMonSgp 	external variable - name of underlying group or monoid
40#V  _KBExtDir 		external variable - directory of external executables
41#V  _KBTmpFileName      external variable - name of temporary file.
42#V  _ExitCode           external variable - exit code of programs.
43##
44_RWS   := rec();
45_RWS_Sub   := rec();
46_RWS_Cos   := rec();
47
48_ExitCode := 0;
49
50#############################################################################
51##
52#F  IsConfluentRWS(<x>) . . . . . . . test whether x is a confluent rws
53##
54##  Public function.
55IsConfluentRWS := function ( x )
56    if not IsKBMAGRewritingSystemRep(x) then return false; fi;
57    if not IsBound(x!.isConfluent) then return false; fi;
58    return  x!.isConfluent;
59end;
60
61#############################################################################
62##
63#F  IsGroupRWS(<rws>) . . . test whether all gens of rws <rws> have inverses
64##
65##  Public function.
66IsGroupRWS := function ( rws )
67    local gp, g;
68    if not IsKBMAGRewritingSystemRep(rws) then return false; fi;
69    gp:=true;
70    for g in rws!.invAlphabet do
71      if g = false then gp:=false; fi;
72    od;
73    return gp;
74end;
75
76#############################################################################
77##
78#F  IsMonoidRWS(<rws>) . . . does <rws> represent a monid
79##
80##  This merely returns the value of rws!.hasOne.
81##  Note that if this is false, then there should be no inverses!
82##  Public function.
83IsMonoidRWS := function ( rws )
84    if not IsKBMAGRewritingSystemRep(rws) then return false; fi;
85    return rws!.hasOne;
86end;
87
88#############################################################################
89##
90#F  LinePrintRWS(<line> [,<filename>]) . . . . . . . print the line x
91##
92##  LinePrintRWS prints the line (a string) to the terminal (default)
93##  or to file filename  if specified, formatting nicely.
94##  It works by building up the material to be printed line by line as strings,
95##  and calling LinePrintRWS to print each individual line.
96LinePrintRWS := function ( arg )
97    local line, filename;
98    line := arg[1];
99    if Length(arg) = 1 then
100      filename := "";
101    else
102      filename := arg[2];
103    fi;
104    if filename = "" then
105      Print(line,"\n");
106    else
107      AppendTo(filename,line,"\n");
108    fi;
109end;
110
111#############################################################################
112##
113#F  FpStructureRWS(<rws>) . finitely presented group or semigroup defining <rws>
114##
115##  Public function.
116FpStructureRWS := function ( rws )
117  local F, M, IdWord, rels, gens, ng, i, ig, eqn, w1, w2;
118  if not IsKBMAGRewritingSystemRep(rws)  then
119     Error("Argument is not an KBMAG rewriting system.");
120  fi;
121  if IsBound(rws!.GpMonSgp) then
122     return rws!.GpMonSgp;
123  fi;
124  ## We have to calculate it!
125  M := rws!.WordMonoid;
126  IdWord := One(M);
127  rels := Set([]);
128  gens := rws!.alphabet;
129  ng := Length(rws!.alphabet);
130  for i in [1..ng] do
131    ig := rws!.invAlphabet[i];
132    if ig <> false then
133      AddSet(rels,[gens[i]*gens[ig],IdWord]);
134      AddSet(rels,[gens[ig]*gens[i],IdWord]);
135    fi;
136  od;
137  for eqn in rws!.equations do
138    w1 := ListToWordRWS(eqn[1],gens);
139    w2 := ListToWordRWS(eqn[2],gens);
140    if w1<>w2 then AddSet(rels,[w1,w2]); fi;
141  od;
142  #Now convert to external representation.
143  F := rws!.FreeGpMonSgp;
144  rels := List(rels,r -> [rws!.IntToExt(rws!.ExtIntCorr,r[1]),
145                          rws!.IntToExt(rws!.ExtIntCorr,r[2])] );
146  if IsGroup(F) then
147    rels := List(rels,r -> r[1]/r[2] );
148  fi;
149
150  rws!.GpMonSgp := F/rels;
151  return rws!.GpMonSgp;
152end;
153
154#############################################################################
155##
156#F  IsAvailableNormalFormRWS(<x>) . . . . test whether x has a normal form
157##
158##  Public function.
159IsAvailableNormalFormRWS := function ( x )
160    return IsKBMAGRewritingSystemRep(x) and
161           IsBound(x!.isAvailableNormalForm) and
162                   x!.isAvailableNormalForm=true;
163end;
164
165#############################################################################
166##
167#F  IsAvailableReductionRWS(<x>) . . test whether x has a reduction algorithm
168##
169##  Public function.
170IsAvailableReductionRWS := function ( x )
171    return IsKBMAGRewritingSystemRep(x) and
172           IsBound(x!.isAvailableReduction)
173                 and x!.isAvailableReduction=true;
174end;
175
176#############################################################################
177##
178#F  IsAvailableSizeRWS(<x>) . . test whether x has a size algorithm
179##
180##  Public function.
181IsAvailableSizeRWS := function ( x )
182    return IsKBMAGRewritingSystemRep(x) and
183           IsBound(x!.isAvailableSize)
184                 and x!.isAvailableSize=true;
185end;
186
187#############################################################################
188##
189#F  ResetRWS(<rws>)  . . . . . . . . . . . reset rws after a call of KBRUN.
190##
191##  Public function.
192##  This resets a rewriting system back to the original equations, after a
193##  call of KBRUN or AutRWS.
194ResetRWS := function ( rws )
195    if not IsKBMAGRewritingSystemRep(rws)  then
196       Error("First argument is not a rewriting system.");
197    fi;
198    Unbind(rws!.KBRun);
199    Unbind(rws!.isConfluent);
200    Unbind(rws!.isAvailableNormalForm);
201    Unbind(rws!.isAvailableReduction);
202    Unbind(rws!.isAvailableSize);
203    Unbind(rws!.warningOn);
204    Unbind(rws!.reductionFSA);
205    Unbind(rws!.wa);
206    Unbind(rws!.diff1);
207    Unbind(rws!.diff1c);
208    Unbind(rws!.diff2);
209    Unbind(rws!.gm);
210    if IsBound(rws!.originalEquations) then
211       Unbind(rws!.equations);
212       rws!.equations := rws!.originalEquations;
213       Unbind(rws!.originalEquations);
214    fi;
215end;
216
217#############################################################################
218##
219#F  NumberSubgroupRWS(<rws>, <subrws>) . . . number of a subgroup of an <rws>
220##
221##  <rws> should be a rewriting system and <subrws> a subgroup.
222##  The number of the subgroup is returned, or fail if it is not a subgroup.
223##  (Should be in rwssub4.g really but needed by next function.)
224NumberSubgroupRWS := function(rws, subrws)
225  local i;
226  if not IsGroupRWS(rws) then
227     Error("NumberSubgroupRWS only applies to rewriting systems from groups.");
228  fi;
229  if not IsKBMAGRewritingSystemRep(subrws) or
230                    not IsBound(subrws!.alphabet) then
231     Error(
232    "Second argument of NumberSubgroupRWS must be have generators.");
233  fi;
234  if not IsBound(rws!.subgroups)
235    then return fail;
236  fi;
237  for i in [1..rws!.numSubgroups] do
238    if rws!.subgroups[i]!.alphabet = subrws!.alphabet then
239       return i;
240    fi;
241  od;
242  return fail;
243end;
244
245#############################################################################
246##
247#F  SetOrderingRWS(<rws>,<ord>[,list])
248##                          . . .  specify the ordering of a rewriting system
249##
250##  <rws> should be a rewriting system, and <ord> one of the strings that
251##  defines an ordering on the words in the alphabet of <rws>.
252##  These are "shortlex", "recursive", rt_recursive", "wtlex" and "wreathprod".
253##  In the case of "wtlex" and "wreathprod", the extra parameter <list> is
254##  required, and it should be a list of ng (= number of alphabet of <rws>)
255##  non-negative integers, specifying the weights or the levels of the
256##  alphabet, respectively, for this ordering.
257##  Public function.
258SetOrderingRWS := function ( arg )
259    local rws, ord, list, ng, go, i;
260    if Length(arg)<2 or Length(arg)>3 then
261       Error("SetOrderingRWS has 2 or 3 arguments");
262    fi;
263    rws:=arg[1];
264    ord:=arg[2];
265    if Length(arg)=3 then
266      list:=arg[3];
267    else
268      list:=[];
269    fi;
270    if not IsKBMAGRewritingSystemRep(rws)  then
271       Error("First argument is not an KBMAG rewriting system.");
272    fi;
273    if not IsString(ord) then
274       Error("Second argument is not a string.");
275    fi;
276
277    ng := Length(rws!.alphabet);
278    if Length(arg)=3 then
279      if not IsList(list) or Length(list)<>ng then
280         Error("Third argument is not a list of length <ng>.");
281      fi;
282      for i in [1..ng] do
283        if not IsInt(list[i]) or list[i]<0 then
284          Error("Third argument is not a list of non-negative integers.");
285        fi;
286      od;
287    fi;
288
289    if ord="shortlex" or ord="recursive" or ord="rt_recursive" or
290       ord="wtlex" or ord="wreathprod" then
291      rws!.ordering:=ord;
292    else
293      Error("Unknown ordering",ord);
294    fi;
295    if (ord="wtlex" or ord="wreathprod") and list=[] then
296      Error("Third argument required for ordering",ord);
297    fi;
298    if ord="wtlex" then rws!.weight:=list; fi;
299    if ord="wreathprod" then rws!.level:=list; fi;
300end;
301
302#############################################################################
303##
304#F  ReorderGeneratorsRWS(<rws>,<p>) . reorder alphabet of a rewriting system
305##
306##  <rws> should be a rewriting system, and <p>  a permutation of the set
307##  [1..ng], where <rws> has <ng> = length of alphabet.
308##  The alphabet of <rws> is reordered by applying the permutation <p> to
309##  its existing order.
310##  Public function.
311ReorderGeneratorsRWS := function ( rws, p )
312    local ng, list, i, eqn;
313    if not IsKBMAGRewritingSystemRep(rws)  then
314       Error("First argument is not an KBMAG rewriting system.");
315    fi;
316    if not IsPerm(p) then
317       Error("Second argument is not a permutation.");
318    fi;
319    ng := Length(rws!.alphabet);
320    if LargestMovedPointPerm(p) > ng then
321       Error("Permutation is on more points than there are alphabet!");
322    fi;
323
324    list:=[];
325    for i in [1..ng] do list[i^p]:=rws!.alphabet[i]; od;
326    rws!.alphabet:=list;
327
328    list:=[];
329    for i in [1..ng] do
330      if IsInt(rws!.invAlphabet[i]) then
331        list[i^p]:=rws!.invAlphabet[i]^p;
332      else list[i^p] := false;
333      fi;
334    od;
335    rws!.invAlphabet:=list;
336
337    for eqn in rws!.equations do
338      list := List(eqn[1],i->i^p);
339      eqn[1]:=list;
340      list := List(eqn[2],i->i^p);
341      eqn[2]:=list;
342    od;
343
344    if IsBound(rws!.originalEquations) then
345      for eqn in rws!.originalEquations do
346        list := List(eqn[1],i->i^p);
347        eqn[1]:=list;
348        list := List(eqn[2],i->i^p);
349        eqn[2]:=list;
350      od;
351    fi;
352
353    if IsBound(rws!.weight) then
354      list:=[];
355      for i in [1..ng] do list[i^p]:=rws!.weight[i]; od;
356      rws!.weight:=list;
357    fi;
358
359    if IsBound(rws!.level) then
360      list:=[];
361      for i in [1..ng] do list[i^p]:=rws!.level[i]; od;
362      rws!.level:=list;
363    fi;
364end;
365
366#############################################################################
367##
368#F  ReadRWS(<filename>, [semigp])  . . . .read and convert a rewriting system
369##
370##  ReadRWS reads a rewriting system, which must be declared with the
371##  external variable name "_RWS" from the file <filename>, and converts it
372##  to internal format. First it creates and reads the GAP preprocessor file
373##  <filename>.gap, for the declarations of variable names.
374##  This is created using the external program "ppgap".
375##  The rewriting system is returned.
376##  If the optional second argument is true, then the rewriting system is
377##  regarded as being for a semigroup rather than for a monoid (default).
378##  This means that the empty word is not part of the language.
379##  For this to be the case there must be no inverses, or an error will result.
380##  Public function.
381ReadRWS := function ( arg )
382    local i, rgm, rfgm, rws, ng, p, ig, ri,
383          eqn, filename, semigp, mnames, fam, isgp, l, s, gtom, igtom;
384
385    filename:=arg[1];
386    if Length(arg)>1 then
387      semigp := arg[2];
388    else
389      semigp := false;
390    fi;
391    Exec(Concatenation(Filename(_KBExtDir,"ppgap4")," ",filename));
392    Read(Concatenation(filename,".gap4"));
393    Exec(Concatenation("/bin/rm -f ",filename,".gap4"));
394
395    rfgm := _RWS.FreeGpMonSgp;
396                  #This is about to get overwritten, so we remember it!
397
398    if not READ(filename) then Error("Could not open file for reading"); fi;
399
400    rws := _RWS; _RWS := rec(); #reset _RWS for next time
401
402    rws.FreeGpMonSgp := rfgm;
403    isgp := IsGroup(rfgm);
404    rws.hasOne := not semigp;
405    rws.options := rec();
406
407    #Several of the fields of the rewriting system are stored differently
408    #or have different names in the internal storage, than the way they
409    #appear in the file.
410    ng := Length(rws.generatorOrder);
411
412    #Internally, inverses are not stored as a list of alphabet, but as
413    #a list of integers (in the field invAlphabet), giving the position
414    #of the inverse generator in the generator list.
415    ri := rws.inverses;
416    ig := []; rws.invAlphabet := ig;
417    for i in [1..ng] do
418      if IsBound(ri[i]) then
419        ig[i] := Position(rws.generatorOrder,ri[i]);
420        if semigp then
421          Error("There can be no inverse in a semigroup.");
422        fi;
423      else
424        ig[i] := false;
425      fi;
426    od;
427    Unbind(rws.inverses);
428
429
430    #The left- and right-hand sides of the equations are not stored
431    #internally as words, but as lists of integers, giving the numbers of
432    #the alphabet appearing in the list.
433    for eqn in rws.equations do
434        eqn[1] := WordToListRWS(eqn[1],rws.generatorOrder);
435        eqn[2] := WordToListRWS(eqn[2],rws.generatorOrder);
436    od;
437
438    mnames := [];
439    for i in [1..ng] do
440      if isgp then mnames[i] := Concatenation("_g",String(i));
441      else mnames[i] := Concatenation("_m",String(i));
442      fi;
443    od;
444    rws.WordMonoid := FreeMonoid(mnames);
445    rws.alphabet := GeneratorsOfMonoid(rws.WordMonoid);
446
447    #Now we have to set up the Ext/Int correspondence.
448    #This is tricky for groups, because some of the names in the
449    #external file might have form "x^-1".
450    if isgp then
451      gtom := []; igtom :=[];
452      for i in [1..ng] do
453        s:=String(rws.generatorOrder[i]);
454        l:=Length(s);
455        if l<=3 or s{[l-2..l]} <> "^-1" then
456          Add(gtom,i);
457          Add(igtom,rws.invAlphabet[i]);
458        fi;
459      od;
460      rws.ExtIntCorr :=
461         CorrespondenceGroupMonoid(rfgm,rws.WordMonoid,gtom,igtom);
462      rws.ExtToInt := FreeGroup2FreeMonoid;
463      rws.IntToExt := FreeMonoid2FreeGroup;
464    else
465      rws.ExtIntCorr :=
466         CorrespondenceGroupMonoid(rfgm,rws.WordMonoid);
467      rws.ExtToInt := FreeMS2FreeMonoid;
468      rws.IntToExt := FreeMonoid2FreeMS;
469    fi;
470    Unbind(rws.generatorOrder); #we no longer use this field.
471
472    fam := NewFamily("Family of Knuth-Bendix Rewriting systems",
473                IsKnuthBendixRewritingSystem);
474    rws := Objectify(NewType(fam,
475                IsMutable and IsKnuthBendixRewritingSystem
476                and IsKBMAGRewritingSystemRep),
477                rws);
478    FpStructureRWS(rws);
479    return rws;
480end;
481
482#############################################################################
483##
484#F  ExtVarHandlerRWS(<rws>, <filename>) . . write file to handle externals
485##
486## This is hopefully a temporary hack, for use until GAP V4, where should be
487## a better solution. A GAP file is written to preserve any existing values
488## of external variables corresponding to the generator names of the
489## rewriting system <rws>, and then to declare these variables to be equal
490## to the corresponding alphabet of <rws>. This is necessary for reading
491## back in the output of KBRWS or AutRWS, which uses these names.
492## This first file is called <rws>.gap1.
493## A second file <rws>.gap2 is written for reading afterwards, which restores
494## the values of any previously existing externals with those names.
495## The files are read by the following two functions below.
496##
497ExtVarHandlerRWS  := function(rws, filename)
498    local file1, file2, ng, names, line, i, ni, l;
499    file1 := Concatenation(filename,".gap1");
500    file2 := Concatenation(filename,".gap2");
501    PrintTo(file1,"_RWS.oldNames:=false;\n");
502    PrintTo(file2,"");
503
504    ng := Length(rws!.alphabet);
505    names := List(rws!.alphabet,x->String(x));
506    _RWS.WordMonoid := rws!.WordMonoid;
507    for i in [1..ng] do _RWS.(i) := rws!.alphabet[i]; od;
508
509    for i in [1..ng] do
510      ni := names[i]; l := Length(ni);
511      if l <= 3 or ni{[l-2..l]} <> "^-1" then
512        line := Concatenation("if IsBound(",ni,") and ",ni,
513            " <> _RWS.WordMonoid.",String(i)," then _RWS.",String(i+ng),":=",
514               ni,"; _RWS.oldNames:=true; fi;\n");
515        line := Concatenation(line,ni,":=_RWS.WordMonoid.",String(i),";\n");
516        AppendTo(file1,line);
517        line := Concatenation("if IsBound(_RWS.",String(i+ng),") then ",
518                ni,":=_RWS.",String(i+ng),"; fi;\n");
519        AppendTo(file2,line);
520      fi;
521    od;
522    line := Concatenation(
523       "if IsBound(_) and _ <> One(_RWS.WordMonoid) then _RWS.",
524       String(2*ng+1), ":=_;\n    _RWS.oldNames:=true; fi;\n");
525    line := Concatenation(line,"_:=One(_RWS.WordMonoid);\n");
526    AppendTo(file1,line);
527    line := Concatenation("if IsBound(_RWS.",String(2*ng+1),
528          ") then  _:=_RWS.",String(2*ng+1),"; fi;\n");
529    AppendTo(file2,line);
530    line := Concatenation(
531    "if IsBound(IdWord) and IdWord <> One(_RWS.WordMonoid) then _RWS.",
532          String(2*ng+2), ":=IdWord;\n     _RWS.oldNames:=true; fi;\n");
533    line := Concatenation(line,"IdWord:=One(_RWS.WordMonoid);\n");
534    AppendTo(file1,line);
535    line := Concatenation("if IsBound(_RWS.",String(2*ng+2),
536          ") then  IdWord:=_RWS.",String(2*ng+2),"; fi;\n");
537    AppendTo(file2,line);
538end;
539
540#############################################################################
541##
542#F  StoreNamesRWS(<rws>, <filename>)
543##  Store existing variables before reading external file.
544StoreNamesRWS := function(rws, filename)
545    local i;
546    ExtVarHandlerRWS(rws,filename);
547    Read(Concatenation(filename,".gap1"));
548    rws!.oldNames := _RWS.oldNames;
549end;
550
551#############################################################################
552##
553#F  RedefineNamesRWS(<rws>, <filename>)
554##  Redefine existing variables after reading external file.
555##  Store existing variables.
556RedefineNamesRWS := function(rws, filename)
557    local i;
558    if rws!.oldNames then
559      Read(Concatenation(filename,".gap2"));
560    fi;
561    _RWS := rec();
562    _RWS_Cos := rec();
563end;
564
565#############################################################################
566##
567#F  UpdateRWS(<rws>, <filename>, <kb>, [<cosets>])
568##                              . . update rws, after run of external program
569##
570## This function is called after a run of one of the "documented" external
571## programs (currently KBRWS and AutRWS) on the rewriting system <rws>.
572## It updates <rws> being careful to reset any external variables that were
573## used by the external program, but previously existed in the current GAP
574## session.   <filename> should be the file in which the
575## original rewriting-system was stored. <kb> should be true or false,
576## according to whether the function is being called from a Knuth-Bendix
577## application (KBRWS) or automatic groups (AutRWS).
578## In the Knuth-Bendix case, <filename>.kbprog is read in, for the updated
579## version of the equations. Then <filename>.reduce is read in
580## for the reduction machine.
581## In the automatic groups case, <filename>.wa is read in for the word-acceptor,
582## and then <filename.diff2> and <filename>.diff1c for the word-difference
583## machines used in word  reduction.
584##
585
586UpdateRWS := function(arg)
587	local rws, filename, kb, cosets, _RWSrec, x, i, j, k, l, eqn, twovar,
588              fsa, fsa2, fsa3, newrow, ig, mg, alph, la, efilename;
589
590    rws := arg[1];
591    filename := arg[2];
592    kb := arg[3];
593    cosets := false;
594    if Length(arg)>=4 then
595      cosets := arg[4];
596    fi;
597
598    #Make preprocessing file
599    StoreNamesRWS(rws, filename);
600    if cosets then
601      _RWS_Cos := _RWS;
602    fi;
603
604    mg := GeneratorsOfMonoid(rws!.WordMonoid);
605    if cosets then
606      alph := rws!.baseAlphabet;
607    else
608      alph := rws!.alphabet;
609    fi;
610    la := Length(alph);
611    if kb then
612      #Read in updated version of equations.
613      if not READ(Concatenation(filename,".kbprog")) then
614         Error("Could not open output of external Knuth-Bendix program.");
615      fi;
616      if cosets then _RWSrec := _RWS_Cos; else _RWSrec := _RWS; fi;
617      rws!.equations := _RWSrec.equations;
618      for eqn in rws!.equations do
619        eqn[1] := WordToListRWS(eqn[1],mg);
620        eqn[2] := WordToListRWS(eqn[2],mg);
621      od;
622      rws!.isConfluent := _RWSrec.isConfluent;
623      if cosets then
624        rws!.ordering := _RWSrec.ordering;
625        rws!.level := _RWSrec.level;
626      fi;
627    fi;
628
629    # read automata
630    if kb then
631      if not READ(Concatenation(filename,".reduce")) then
632         Error("Could not open reduction machine file");
633      fi;
634      fsa:= _RWSrec.reductionFSA;
635      rws!.reductionFSA := fsa;
636      if not rws!.hasOne then # empty word should not be accepted.
637        fsa.accepting := [2..fsa.states.size];
638      fi;
639      for i in [1..la] do
640        fsa.alphabet.names[i] := alph[i];
641        #They may got re-ordered!
642      od;
643    else
644      if cosets then _RWSrec := _RWS_Cos; else _RWSrec := _RWS; fi;
645      if not READ(Concatenation(filename,".wa")) then
646         Error("Could not open word-acceptor file");
647      fi;
648      fsa := _RWSrec.wa;
649      rws!.wa := fsa;
650      for i in [1..la] do
651        fsa.alphabet.names[i] := alph[i];
652        #They may got re-ordered!
653      od;
654      if cosets then efilename:=Concatenation(filename,".midiff1");
655      else efilename:=Concatenation(filename,".diff1c");
656      fi;
657      if not READ(efilename) then
658         Error("Could not open word-difference file");
659      fi;
660      if cosets then fsa2 := _RWS.midiff1; else fsa2 := _RWS.diff1c; fi;
661      if cosets then rws!.midiff1 := fsa2; else rws!.diff1 := fsa2; fi;
662      if cosets then efilename:=Concatenation(filename,".midiff2");
663      else efilename:=Concatenation(filename,".diff2");
664      fi;
665      if not READ(efilename) then
666         Error("Could not open word-difference file");
667      fi;
668      if cosets then fsa3 := _RWS.midiff2; else fsa3 := _RWS.diff2; fi;
669      if cosets then rws!.midiff2 := fsa3; else rws!.diff2:=fsa3; fi;
670      #fsa2.alphabet.type := "simple";
671      #fsa3.alphabet.type := "simple";
672      for i in [1..la] do
673        fsa2.states.alphabet[i] := alph[i];
674        fsa3.states.alphabet[i] := alph[i];
675        #They may got re-ordered!
676      od;
677    fi;
678
679    #Reset any lost existing externals
680    RedefineNamesRWS(rws, filename);
681
682    InitializeFSA(fsa);
683    #Make sure the table is stored densely
684    DenseDTableFSA(fsa);
685    fsa.table.format:="dense deterministic";
686    fsa.table.transitions:=fsa.denseDTable;
687    Unbind(fsa.sparseTable);
688    fsa.alphabet.printingStrings:=List(rws!.alphabet,x->String(x));
689    if not kb then
690       InitializeFSA(fsa2);
691       InitializeFSA(fsa3);
692       #Make sure the table is stored densely
693       DenseDTableFSA(fsa2);
694       DenseDTableFSA(fsa3);
695       #fsa2.alphabet.base.printingStrings:=List(rws!.alphabet,x->String(x));
696       #fsa3.alphabet.base.printingStrings:=List(rws!.alphabet,x->String(x));
697       fsa2.states.printingStrings:=List(rws!.alphabet,x->String(x));
698       fsa3.states.printingStrings:=List(rws!.alphabet,x->String(x));
699       fsa2.table.format:="dense deterministic";
700       fsa3.table.format:="dense deterministic";
701       fsa2.table.transitions:=fsa.denseDTable;
702       fsa3.table.transitions:=fsa.denseDTable;
703       Unbind(fsa2.sparseTable);
704       Unbind(fsa3.sparseTable);
705    fi;
706end;
707
708#############################################################################
709##
710#F  WriteRWS(<rws>, [<filename>], [<endsymbol>])
711##           . . . . . . . . . . . .write an rws to a file in external format
712##
713##  WriteRWS prints the rws <rws> to the  file <filename> formatting nicely.
714##  It works by building up the material to be printed line by line as strings,
715##  and calling LinePrintRWS to print each individual line.
716##  If <filename> is not present, or empty, then writing is to the terminal
717##  and is simply of form rec(..).
718##  Otherwise, printing takes form _RWS := rec(...)<endsymbol>
719##  where <endsymbol> is a string which is ";" by default.
720##  (_RWS is a global variable.)
721##
722##  Public function.
723WriteRWS := function ( arg )
724    local rws, name, filename, gapfilename, line, i, eqn, endsymbol,
725          ng, en, gn, ls, ig;
726
727    if Length(arg)<1 then
728       Error("WriteRWS has 1, 2 or 3 arguments");
729    fi;
730    rws := arg[1];
731    filename := "";
732    if Length(arg)>=2 then filename := arg[2]; fi;
733    if filename="" then endsymbol := ""; else endsymbol := ";"; fi;
734    if Length(arg)>=3 then endsymbol := arg[3]; fi;
735
736    if not IsKBMAGRewritingSystemRep(rws) then
737      Error("First argument is not an KBMAG rewriting system.");
738    fi;
739
740    ng := Length(rws!.alphabet);
741    en := List(rws!.alphabet,x->String(x));
742
743    #Now print main file
744    if filename="" then Print("rec(\n");
745    else PrintTo(filename,"_RWS := rec (\n");
746    fi;
747
748    line := String("isRWS",16);
749    line := Concatenation(line," := true,");
750    LinePrintRWS(line,filename);
751
752    if IsBound(rws!.isConfluent) then
753      line := String("isConfluent",16);
754      line := Concatenation(line," := ",String(rws!.isConfluent),",");
755      LinePrintRWS(line,filename);
756    fi;
757
758#Now come all of the optional parameters
759    if IsBound(rws!.options.tidyint) then
760      line := String("tidyint",16);
761      line := Concatenation(line," := ",String(rws!.options.tidyint),",");
762      LinePrintRWS(line,filename);
763    fi;
764    if IsBound(rws!.options.maxeqns) then
765      line := String("maxeqns",16);
766      line := Concatenation(line," := ",String(rws!.options.maxeqns),",");
767      LinePrintRWS(line,filename);
768    fi;
769    if IsBound(rws!.options.maxstates) then
770      line := String("maxstates",16);
771      line := Concatenation(line," := ",String(rws!.options.maxstates),",");
772      LinePrintRWS(line,filename);
773    fi;
774    if IsBound(rws!.options.maxreducelen) then
775      line := String("maxreducelen",16);
776      line := Concatenation(line," := ",String(rws!.options.maxreducelen),",");
777      LinePrintRWS(line,filename);
778    fi;
779    if IsBound(rws!.options.confnum) then
780      line := String("confnum",16);
781      line := Concatenation(line," := ",String(rws!.options.confnum),",");
782      LinePrintRWS(line,filename);
783    fi;
784    if IsBound(rws!.options.maxwdiffs) then
785      line := String("maxwdiffs",16);
786      line := Concatenation(line," := ",String(rws!.options.maxwdiffs),",");
787      LinePrintRWS(line,filename);
788    fi;
789    if IsBound(rws!.options.maxstoredlen) then
790      line := String("maxstoredlen",16);
791      line := Concatenation(line, " := [",
792              String(rws!.options.maxstoredlen[1]),",",
793                               String(rws!.options.maxstoredlen[2]),"],");
794      LinePrintRWS(line,filename);
795    fi;
796    if IsBound(rws!.options.sorteqns) then
797      line := String("sorteqns",16);
798      line := Concatenation(line," := ",String(rws!.options.sorteqns),",");
799      LinePrintRWS(line,filename);
800    fi;
801    if IsBound(rws!.options.maxoplen) then
802      line := String("maxoplen",16);
803      line := Concatenation(line," := ",String(rws!.options.maxoplen),",");
804      LinePrintRWS(line,filename);
805    fi;
806    if InfoLevel(InfoRWS)=0 then
807      line := String("silent",16);
808      line := Concatenation(line," := true,");
809      LinePrintRWS(line,filename);
810    fi;
811    if InfoLevel(InfoRWS)>1 then
812      line := String("verbose",16);
813      line := Concatenation(line," := true,");
814      LinePrintRWS(line,filename);
815    fi;
816    if InfoLevel(InfoRWS)>2 then
817      line := String("veryVerbose",16);
818      line := Concatenation(line," := true,");
819      LinePrintRWS(line,filename);
820    fi;
821
822    line := Concatenation(String("generatorOrder",16)," := [");
823    for i in [1..ng] do
824      if i > 1 then
825        line := Concatenation(line,",");
826      fi;
827      if i=1 or Length(line)+Length(en[i]) <= 76 then
828        line := Concatenation(line,en[i]);
829      else
830        LinePrintRWS(line,filename);
831        line := String("",21);
832        line := Concatenation(line,en[i]);
833      fi;
834    od;
835    line := Concatenation(line,"],");
836    LinePrintRWS(line,filename);
837
838    ig := rws!.invAlphabet;
839    line := Concatenation(String("inverses",16)," := [");
840    for i in [1..ng] do
841      if i > 1 then line := Concatenation(line,","); fi;
842      if IsInt(ig[i]) and ig[i]>0 then
843        if i=1 or Length(line)+Length(en[ig[i]]) <= 76 then
844          line := Concatenation(line,en[ig[i]]);
845        else
846          LinePrintRWS(line,filename);
847          line := String("",21);
848          line := Concatenation(line,en[ig[i]]);
849        fi;
850      fi;
851    od;
852    line := Concatenation(line,"],");
853    LinePrintRWS(line,filename);
854
855    if not IsString(rws!.ordering) then
856       Error("Can only output orderings that are strings");
857    fi;
858    line := String("ordering",16);
859    line := Concatenation(line," := \"",rws!.ordering,"\",");
860    LinePrintRWS(line,filename);
861
862    if rws!.ordering="wtlex" and IsBound(rws!.weight) then
863      line := Concatenation(String("weight",16)," := [");
864      for i in [1..ng] do
865        if i > 1 then
866          line := Concatenation(line,",");
867        fi;
868        line := Concatenation(line,String(rws!.weight[i]));
869      od;
870      line := Concatenation(line,"],");
871      LinePrintRWS(line,filename);
872    fi;
873
874    if rws!.ordering="wreathprod" and IsBound(rws!.level) then
875      line := Concatenation(String("level",16)," := [");
876      for i in [1..ng] do
877        if i > 1 then
878          line := Concatenation(line,",");
879        fi;
880        line := Concatenation(line,String(rws!.level[i]));
881      od;
882      line := Concatenation(line,"],");
883      LinePrintRWS(line,filename);
884    fi;
885
886    line := Concatenation(String("equations",16)," := [");
887    for i in [1..Length(rws!.equations)] do
888      if i > 1 then line := Concatenation(line,","); fi;
889      LinePrintRWS(line,filename);
890      eqn := rws!.equations[i];
891      line := Concatenation(String("[",10),
892                          StringRWS(ListToWordRWS(eqn[1],rws!.alphabet)),",");
893      if Length(line)>=40 then
894        LinePrintRWS(line,filename);
895        line := String("",10);
896      fi;
897      line :=Concatenation(line,
898                  StringRWS(ListToWordRWS(eqn[2],rws!.alphabet)),"]");
899    od;
900    LinePrintRWS(line,filename);
901    line := String("]",8);
902    LinePrintRWS(line,filename);
903    line := Concatenation(")",endsymbol);
904    LinePrintRWS(line,filename);
905end;
906
907#############################################################################
908##
909#F  IsReducedWordRWS(<rws>,<w>) . . . . tests if a word is reduced
910##
911##  IsReducedWordRWS tests whether the word <w>
912##  is reduced, using the  rewriting system <rws>.
913##  <w> can be given either as a list of integers (internal format) or as
914##  a word in the generators of the underlying group or monoid.
915##  Either the word-acceptor (automatic group case) or the reduction FSA
916##  must be defined.
917##  It merely calls the corresponding FSA function.
918##
919##  Public function.
920IsReducedWordRWS := function ( rws, w )
921    local i, ng;
922    if not IsKBMAGRewritingSystemRep(rws)  then
923       Error("First argument is not an KBMAG rewriting system.");
924    fi;
925    if not IsAvailableReductionRWS(rws) then
926       Error(
927   "Reduction algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
928    fi;
929    if not IsList(w) and not IsWord(w) then
930       Error("Second argument is not a word or list.");
931    fi;
932    ng := Length(rws!.alphabet);
933    if IsWord(w) then
934       w:=WordToListRWS(w,rws!.alphabet);
935    fi;
936    if IsBound(rws!.wa) then
937    # Automatic group case - use word-acceptor
938      return IsAcceptedWordDFA( rws!.wa,w );
939    fi;
940    if not IsBound(rws!.reductionFSA)  then
941       Error("First argument does not have initialized dfa as field.");
942    fi;
943    return IsAcceptedWordDFA( rws!.reductionFSA,w );
944end;
945
946#############################################################################
947##
948#F  ReduceWordWD(<wd>,<w>)
949##                   . . . . .reduces a word using word-difference automaton
950##
951##  ReduceWordWD calculates the reduction of the word <w> (list of integers)
952##  using the word-difference automaton <wd>.
953##  <wd> should be two-variable, where <w> is a list of integers in the range
954##  [1..ng], where ng is the size of the base alphabet.
955##  WARNING: No validity checks are carried out!
956##
957##  Private function.
958ReduceWordWD := function ( wd, w)
959    local  ndiff, ngens, ng1, identity, level, cf, gpref, gct, gptr,
960           diff, newdiff, deqi, gen1, gen2, donesub, donediffs, subvert,dosub,
961           g2ltg1, diffct, t, nlen, olen, i, l, table;
962    if not IsInitializedFSA(wd) then
963       Error("First argument is not an initialized dfa.");
964    fi;
965
966    ndiff := wd.states.size;
967    ngens := wd.alphabet.base.size;
968    ng1 := ngens+1;
969    identity := wd.initial[1];
970    if Length(w) <= 0 then
971      return w;
972    fi;
973    cf := [];
974    # cf is used as a characteristic function, when constructing a subset of the
975    # set  D  of word differences.
976    gpref := []; gct := 0; gpref[1] := 0; gptr := [];
977    # gpref[n]  is the number of "vertices" that have been defined after
978    # reading the first n-1 elements of the word.
979    # These vertices are gptr[1],...,gptr[gpref[n]].
980    # A vertex is a record with 4 components, backptr, genno, diffno, sublen,
981    # It represents a vertex in the graph of strings that may eventually
982    # be used as substituted strings in the word w.
983    # backptr is either undefined or another vertex.
984    # gen is the generator at the vertex.
985    # diffno is the word-difference number of the string at which the vertex
986    #        is at the end - this string is reconstructed using backptr.
987    # sublen is plus or minus the length of this string. sublen is positive
988    #        iff the string lexicographically precedes the corresponding
989    #        prefix of the word being reduced.
990
991    # Now we start scanning the word.
992    table := DenseDTableFSA(wd);
993    level := 1;
994    while level <= Length(w) do
995      for i in [1..ndiff] do cf[i] := false; od;
996      gen1 := w[level];
997      # The next loop is over the identity, and the subset of the set of
998      # word-differences (states of wd) defined at the previous level (level-1)
999
1000      diff := identity;
1001      donesub := false;
1002      donediffs := false;
1003      while not donesub and not donediffs do
1004        deqi := diff = identity;
1005      # First look for a possible substitution of a shorter string
1006        newdiff := table[diff][ng1*gen1];
1007        if newdiff=identity then
1008          #Make substitution  reducing length of word by 1
1009          SubstitutedListFSA(w,level,level,[]);
1010          i := level-1;
1011          if not deqi then
1012            subvert := gptr[diffct];
1013	    dosub := true;
1014            while dosub do
1015              w[i] := subvert.gen;
1016              i := i-1;
1017              if IsBound(subvert.backptr) then
1018	        subvert := subvert.backptr;
1019              else
1020                dosub := false;
1021              fi;
1022            od;
1023          fi;
1024          #Whenever we make a substitution, we have to go back one level more
1025          #than expected, because of our policy of looking ahead for
1026          #substitutions that reduce the length by 2.
1027          if i>0 then level:=i-1; else level:=i; fi;
1028          gct := gpref[level+1];
1029          donesub := true;
1030        elif newdiff>0 and level<Length(w) then
1031          #See if there is a substitution reducing length by 2.
1032          gen2 := w[level+1];
1033          t := table[newdiff][ng1*gen2];
1034          if t=identity then
1035            #Make substitution  reducing length of word by 2
1036            SubstitutedListFSA(w,level,level+1,[]);
1037            i := level-1;
1038            if not deqi then
1039              subvert := gptr[diffct];
1040  	      dosub := true;
1041              while dosub do
1042                w[i] := subvert.gen;
1043                i := i-1;
1044                if IsBound(subvert.backptr) then
1045  	          subvert := subvert.backptr;
1046                else
1047                  dosub := false;
1048                fi;
1049              od;
1050            fi;
1051            if i>0 then level:=i-1; else level:=i; fi;
1052            gct := gpref[level+1];
1053            donesub := true;
1054          fi;
1055        fi;
1056
1057        if not donesub then
1058          #Now we loop over the generator that is a candidate for
1059          #substitution at this point.
1060          for gen2 in [1..ngens] do
1061            g2ltg1 := gen2 < gen1;
1062            newdiff := table[diff][ng1*(gen1-1)+gen2];
1063            if donesub then
1064              donesub := true;
1065              #i.e. do nothing - we really want to break from the for loop here.
1066            elif newdiff=identity then
1067              if deqi then #only occurs when gen2 and gen1 are equal in group
1068                if g2ltg1 then
1069                  w[level] := gen2;
1070                  if level>1 then level:=level-2; else level:=level-1; fi;
1071                  gct := gpref[level+1];
1072                  donesub := true;
1073                fi;
1074              elif gptr[diffct].sublen>0 then
1075                #Make a substitution by a string of equal length.
1076                w[level] := gen2;
1077                i := level-1;
1078                subvert := gptr[diffct];
1079    	        dosub := true;
1080                while dosub do
1081                  w[i] := subvert.gen;
1082                  i := i-1;
1083                  if IsBound(subvert.backptr) then
1084    	            subvert := subvert.backptr;
1085                  else
1086                    dosub := false;
1087                  fi;
1088                od;
1089                if i>0 then level:=i-1; else level:=i; fi;
1090                gct := gpref[level+1];
1091                donesub := true;
1092              fi;
1093            elif newdiff>0 then
1094              if cf[newdiff] then
1095                #We have this word difference stored already, but we will check
1096                #to see if the current string precedes the existing one.
1097                i := gpref[level];
1098                repeat
1099                  i := i+1;
1100                  subvert := gptr[i];
1101                until subvert.diffno=newdiff;
1102                olen := subvert.sublen;
1103                if deqi then
1104                  if g2ltg1 then nlen:=1; else nlen:= -1; fi;
1105                else
1106                  l := gptr[diffct].sublen;
1107                  if l>0 then nlen:=l+1; else nlen:=l-1; fi;
1108                fi;
1109                if nlen > olen then # new string is better than existing one
1110                  subvert.gen := gen2;
1111                  subvert.sublen := nlen;
1112                  if deqi then Unbind(subvert.backptr);
1113                  else subvert.backptr := gptr[diffct];
1114                  fi;
1115                fi;
1116              else
1117               # this is a new word-difference at this level, so
1118               # we define a new vertex.
1119                gct := gct+1;
1120                gptr[gct] := rec();
1121                if deqi then
1122                  if g2ltg1 then nlen:=1; else nlen:= -1; fi;
1123                else
1124                  l := gptr[diffct].sublen;
1125                  if l>0 then nlen:=l+1; else nlen:=l-1; fi;
1126                fi;
1127                subvert := gptr[gct];
1128                subvert.gen := gen2;
1129                subvert.diffno := newdiff;
1130                subvert.sublen := nlen;
1131                if not deqi then subvert.backptr := gptr[diffct]; fi;
1132                cf[newdiff] := true;
1133              fi;
1134            fi;
1135          od; # End of loop over gen2
1136
1137          if not donesub then
1138            #Go on to next word-difference from the previous level
1139            if diff=identity then
1140              if level=1 then
1141                donediffs := true;
1142              else
1143                diffct := gpref[level-1] + 1;
1144              fi;
1145            else
1146              diffct := diffct+1;
1147            fi;
1148            if not donesub and not donediffs then
1149              if diffct > gpref[level] then
1150                donediffs := true;
1151              else
1152                diff := gptr[diffct].diffno;
1153              fi;
1154            fi;
1155          fi;
1156        fi;
1157      od; #end of loop over word-differences at previous level
1158
1159      level := level+1;
1160      gpref[level] := gct;
1161    od;
1162    return w;
1163end;
1164
1165#############################################################################
1166##
1167#F  ReduceWordRWS(<rws>,<w>) . . . . reduces a word using rewriting-system
1168##
1169##  ReduceWordRWS reduces the word <w>, using the rewriting-system <rws>.
1170##  <w> can be given either as a list of integers (internal format) or as
1171##  a word in the generators of the underlying group or monoid.
1172##  Either the reduction FSA, or one of the word-difference automata (in the
1173##  automatic group case) must be defined for <rws>.
1174##  In the latter case, the separate function ReduceWordWD is called.
1175##
1176##  Public function.
1177ReduceWordRWS := function ( rws, w )
1178    local fsa, pos, label, state, history, eqn, sublen, table, ng,  i, word;
1179    if not IsKBMAGRewritingSystemRep(rws)  then
1180       Error("First argument is not an KBMAG rewriting system.");
1181    fi;
1182    if not IsAvailableReductionRWS(rws) then
1183       Error(
1184   "Reduction algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
1185    fi;
1186    if not IsList(w) and not IsWord(w) then
1187       Error("Second argument is not a word or list.");
1188    fi;
1189    ng := Length(rws!.alphabet);
1190    if IsWord(w) then
1191       word :=true;
1192       w:=ShallowCopy(WordToListRWS(w,rws!.alphabet));
1193    else word := false;
1194    fi;
1195    if IsBound(rws!.warningOn) and rws!.warningOn then
1196      if IsBound(rws!.KBRun) and rws!.KBRun then
1197        Print(
1198 "#WARNING: system is not confluent, so reductions may not be to normal form.\n"
1199      );
1200      else
1201        Print(
1202 "#WARNING: word-difference reduction machine is not proven correct,\n",
1203 "          so reductions may not be to normal form.\n");
1204      fi;
1205      rws!.warningOn:=false;
1206           # only give the warning once, or it could become irritating!
1207    fi;
1208    if IsBound(rws!.diff2) then
1209     # automatic group case
1210       w := ReduceWordWD(rws!.diff2,w);
1211    elif IsBound(rws!.diff1c) then
1212     # automatic group case
1213       w := ReduceWordWD(rws!.diff1c,w);
1214    elif IsBound(rws!.diff1) then
1215     # automatic group case
1216       w := ReduceWordWD(rws!.diff1,w);
1217    elif IsBound(rws!.reductionFSA)  then
1218       fsa := rws!.reductionFSA;
1219       if not IsInitializedFSA(fsa) or IsDeterministicFSA(fsa)=false  then
1220          Error("First argument does not have initialized dfa as field.");
1221       fi;
1222
1223       state := fsa.initial[1];
1224       pos := 1;
1225       history:= [];
1226       history[1] := state; # history[i] = state before reading i-th symbol.
1227       table := DenseDTableFSA(fsa);
1228       while pos <= Length(w) do
1229         state := table[state][w[pos]];
1230         if state>0 then
1231           pos := pos+1;
1232           history[pos] := state;
1233         else
1234           state := -state;
1235           eqn := rws!.equations[state];
1236           sublen := Length(eqn[1]);
1237           SubstitutedListFSA(w,pos-sublen+1,pos,eqn[2]);
1238           pos := pos-sublen+1;
1239           state := history[pos];
1240         fi;
1241       od;
1242    else
1243       Error("First argument does not have initialized dfa as field.");
1244    fi;
1245
1246    if not rws!.hasOne and Length(w)=0 then
1247      Error("The empty word does not represent an element of a semigroup.");
1248    fi;
1249    if word then
1250       w := ListToWordRWS(w,rws!.alphabet);
1251    fi;
1252    return w;
1253end;
1254
1255#############################################################################
1256##
1257#F  SizeRWS(<rws>>) . . . . . number of reduced words in a rewriting system
1258##
1259##  This merely calls the corresponding FSA function.
1260##
1261##  Public function.
1262SizeRWS := function ( rws )
1263    if not IsKBMAGRewritingSystemRep(rws)  then
1264       Error("First argument is not a rewriting system.");
1265    fi;
1266    if not IsAvailableSizeRWS(rws) then
1267       Error(
1268   "Size algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
1269    fi;
1270    if IsBound(rws!.warningOn) and rws!.warningOn then
1271      if rws!.KBRun then
1272        Print(
1273 "#WARNING: system is not confluent, so size returned may not be correct.\n"
1274      );
1275      else
1276        Print(
1277 "#WARNING: word-difference reduction machine is not proven correct,\n",
1278 "          so size returned may not be correct.\n");
1279      fi;
1280      rws!.warningOn:=false;
1281           # only give the warning once, or it could become irritating!
1282    fi;
1283    if IsBound(rws!.wa) then
1284     # automatic group case
1285      return LSizeDFA( rws!.wa );
1286    fi;
1287    return LSizeDFA( rws!.reductionFSA );
1288end;
1289
1290#############################################################################
1291##
1292#F  EnumerateRWS(<rws>, <min>, <max>) . . . enumerate reduced words in a rws
1293##
1294##  This merely calls the corresponding FSA function.
1295##  Words are converted to words in generators of underlying group or monoid
1296##  before returning.
1297##
1298##  Public function.
1299EnumerateRWS := function ( rws, min, max )
1300    local ret, x, i;
1301    if not IsKBMAGRewritingSystemRep(rws)  then
1302       Error("First argument is not a rewriting system.");
1303    fi;
1304    if not IsAvailableSizeRWS(rws) then
1305       Error(
1306   "Enumeration algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
1307    fi;
1308    if IsBound(rws!.wa) then
1309     # automatic group case
1310      ret := LEnumerateDFA( rws!.wa,min,max );
1311    else
1312      ret := LEnumerateDFA( rws!.reductionFSA,min,max );
1313    fi;
1314    return ret;
1315end;
1316
1317#############################################################################
1318##
1319#F  SortEnumerateRWS(<rws>, <min>, <max>)  . . enumerate reduced words and sort
1320##
1321##  This merely calls the corresponding FSA function.
1322##  Words are converted to words in generators of underlying group or monoid
1323##  before returning.
1324##
1325##  Public function.
1326SortEnumerateRWS := function ( rws, min, max )
1327    local ret, x, i;
1328    if not IsKBMAGRewritingSystemRep(rws)  then
1329       Error("First argument is not a rewriting system.");
1330    fi;
1331    if not IsAvailableSizeRWS(rws) then
1332       Error(
1333   "Enumeration algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
1334    fi;
1335    if IsBound(rws!.wa) then
1336     # automatic group case
1337      ret := SortLEnumerateDFA( rws!.wa,min,max );
1338    else
1339      ret := SortLEnumerateDFA( rws!.reductionFSA,min,max );
1340    fi;
1341    return ret;
1342end;
1343
1344#############################################################################
1345##
1346#F  SizeEnumerateRWS(<rws>, <min>, <max>)  . . . . number of reduced words
1347##
1348##  This merely calls the corresponding FSA function.
1349##
1350##  Public function.
1351SizeEnumerateRWS := function ( rws, min, max )
1352    if not IsKBMAGRewritingSystemRep(rws)  then
1353       Error("First argument is not a rewriting system.");
1354    fi;
1355    if not IsAvailableSizeRWS(rws) then
1356       Error(
1357   "Enumeration algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
1358    fi;
1359    if IsBound(rws!.wa) then
1360     # automatic group case
1361      return SizeLEnumerateDFA( rws!.wa,min,max );
1362    fi;
1363    return SizeLEnumerateDFA( rws!.reductionFSA,min,max );
1364end;
1365
1366#############################################################################
1367##
1368#F  OrderRWS(<rws>,<w>) . . . . order of word <w> in group or monoid
1369##
1370##  OrderRWS tries to calculate the order of the element represented by the
1371##  word <w> in the group  or monoid of the rewriting system <rws>.
1372##  Either the word-acceptor (automatic group case) or the reduction FSA
1373##  must be defined.
1374##  It could conceivably not terminate, but I have never known that happen!
1375##
1376##  Public function.
1377OrderRWS := function ( rws, w )
1378    local i, ng, fsa, prefix, preford, pt, t, targets, sufford, tracing, x,
1379          z, cr, l;
1380    if not IsKBMAGRewritingSystemRep(rws)  then
1381       Error("First argument is not an KBMAG rewriting system.");
1382    fi;
1383    if not rws!.hasOne then
1384       Error("Order algorithm is only possible in a monoid or group");
1385    fi;
1386    if not IsAvailableReductionRWS(rws) then
1387       Error(
1388   "Reduction algorithm unavailable. Run KnuthBendix or AutomaticStructure.");
1389    fi;
1390    if not IsList(w) and not IsWord(w) then
1391       Error("Second argument is not a word or list.");
1392    fi;
1393    ng := Length(rws!.alphabet);
1394    if IsWord(w) then
1395       w:=ShallowCopy(WordToListRWS(w,rws!.alphabet));
1396    fi;
1397    w := ReduceWordRWS(rws, w);
1398    if Length(w)=0 then
1399       return 1;
1400    fi;
1401    if IsBound(rws!.wa) then
1402    # Automatic group case - use word-acceptor
1403      fsa := rws!.wa;
1404    else
1405      fsa := rws!.reductionFSA;
1406    fi;
1407    prefix := w;
1408    preford := 1;
1409    while true do
1410      #Check prefix is cyclically reduced
1411      cr := true;
1412      while cr do
1413        l := Length(prefix);
1414        if l>1 and rws!.invAlphabet[prefix[1]]=prefix[l] then
1415          #remove first and last terms of prefix, but we must also
1416          #perform the same conjugation operation on w.
1417          w:=Concatenation([prefix[l]],w,[prefix[1]]);
1418          w := ReduceWordRWS(rws,w);
1419          prefix := prefix{[2..l-1]};
1420        else
1421          cr := false;
1422        fi;
1423      od;
1424      #First see if all powers of prefix are reduced - if so, then a
1425      #state of fsa will eventually repeat on tracing w^n, and w will have
1426      #infinite order.
1427      pt := WordTargetDFA(fsa, prefix);
1428      t := pt;
1429      targets := Set([t]);
1430      tracing:=true;
1431      while tracing do
1432        for x in prefix do
1433          t := TargetDFA(fsa, x, t);
1434          if t<=0 then
1435            break;
1436          fi;
1437        od; #for x in prefix
1438        if t<=0 then
1439          tracing := false;
1440        elif t in targets then
1441          return infinity;
1442        else
1443          AddSet(targets,t);
1444        fi;
1445      od; # while tracing
1446      #not all powers of prefix are reduced, so we need to replace prefix
1447      #by reduced word for a higher power.
1448      sufford := 0;
1449      tracing := true;
1450      t := pt;
1451      while tracing do
1452        sufford := sufford+1;
1453        for x in w do
1454          t := TargetDFA(fsa, x, t);
1455          if t<=0 then
1456            tracing := false;
1457            for i in [1..sufford] do
1458              prefix := Concatenation(prefix,w);
1459            od;
1460            prefix := ReduceWordRWS(rws, prefix);
1461            preford := preford + sufford;
1462            if Length(prefix)=0 then
1463              return preford;
1464            fi;
1465            #To improve chance of proving order infinite, we replace
1466            #el and w by cyclic conjugates.
1467            z := rws!.invAlphabet[prefix[1]];
1468            if  z <> false then
1469              w:=Concatenation([z],w,[prefix[1]]);
1470              w := ReduceWordRWS(rws,w);
1471              prefix:=Concatenation([z],prefix,[prefix[1]]);
1472              prefix := ReduceWordRWS(rws,prefix);
1473            fi;
1474            break;
1475          fi;
1476        od; #for x in w
1477      od; #while tracing
1478    od; #while true
1479end;
1480
1481#############################################################################
1482##
1483#F  AddOriginalEqnsRWS(<rws>).
1484##           . . . . add original equations to rws after a call of KBRWS.
1485##
1486##  This appends the original equations to the list of equations, after a
1487##  call of KBRWS. Useful for a re-check, if the external program may have
1488##  deleted some equations.
1489##  After this function, rewriting is no longer possible.
1490##  Public function.
1491AddOriginalEqnsRWS := function ( rws )
1492    if not IsKBMAGRewritingSystemRep(rws)  then
1493       Error("First argument is not a rewriting system.");
1494    fi;
1495    Unbind(rws!.reductionFSA);
1496    Unbind(rws!.isConfluent);
1497    if IsBound(rws!.originalEquations) then
1498      Append(rws!.equations,rws!.originalEquations);
1499    fi;
1500end;
1501
1502#############################################################################
1503##
1504#F  KBRWS(<rws>)  . . . . call external Knuth-Bendix program on rws
1505##
1506##  This returns true if a confluent rewriting system results - otherwise
1507##  false. In the latter case, words can still be rewritten with respect to
1508##  the current equations, but they are not guaranteed to reduce to the unique
1509##  representative of the group element.
1510##  An error message results if the external program aborts without outputting.
1511##  Public function.
1512KBRWS := function ( rws )
1513    local O, callstring;
1514    if not IsKBMAGRewritingSystemRep(rws)  then
1515       Error("First argument is not a rewriting system.");
1516    fi;
1517    if IsConfluentRWS(rws) then
1518       Print("#The rewriting system is already confluent.\n");
1519       Print("#Call - ResetRWS(<rws>) to restart.\n");
1520       return fail;
1521    fi;
1522    #If we have already run KBRWS then the original equations will
1523    #have been kept and should be re-inserted.
1524    AddOriginalEqnsRWS(rws);
1525    #Keep the original equations, in case we want them again.
1526    if not IsBound(rws!.originalEquations) then
1527      rws!.originalEquations := StructuralCopy(rws!.equations);
1528    fi;
1529    WriteRWS(rws,_KBTmpFileName);
1530    callstring := Concatenation(Filename(_KBExtDir,"kbprog")," ",_KBTmpFileName);
1531    Info(InfoRWS,1,"Calling external Knuth-Bendix program.");
1532    Info(InfoRWS,3,"  ", callstring);
1533    Exec(callstring);
1534    UpdateRWS(rws,_KBTmpFileName,true);
1535    Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1536    Info(InfoRWS,1,"External Knuth-Bendix program complete.");
1537
1538    if rws!.isConfluent then
1539      O := rws!.options;
1540      if IsBound(O.maxstoredlen) or IsBound(O.maxoplen) then
1541        Print(
1542 "#WARNING: Because of the control parameters you set, the system may\n");
1543        Print(
1544 "#         not be confluent. Unbind the parameters and re-run KnuthBendix\n");
1545        Print(
1546 "#         to check!\n");
1547        rws!.isConfluent:=false;
1548      fi;
1549    fi;
1550    if rws!.isConfluent then
1551      Info(InfoRWS,1,"System computed is confluent.");
1552      rws!.isAvailableNormalForm := true;
1553      rws!.warningOn := false;
1554    else
1555      Info(InfoRWS,1,"System computed is NOT confluent.");
1556      rws!.isAvailableNormalForm := false;
1557      rws!.warningOn := true;
1558    fi;
1559    rws!.KBRun := true;
1560    rws!.isAvailableReduction := true;
1561    rws!.isAvailableSize := true;
1562    return rws!.isConfluent;
1563end;
1564
1565#############################################################################
1566##
1567#F  AutRWS(<rws>, [<large>], [<filestore>], [<diff1>])
1568##                      . . . . call external automatic group program on rws
1569##
1570##  This returns true if the automatic group programs succeed - otherwise
1571##  false.
1572##  The optional parameters are all boolean, and false by default.
1573##  <large> means problem is large - the external programs use bigger tables.
1574##  <filestore> means external programs use less core memory and more external
1575##         files - they run a little slower.
1576##  <diff1> is necessary on some examples - see manual for information.
1577##  Public function.
1578AutRWS := function ( arg )
1579    local  narg, rws, large, filestore, diff1, callstring, optstring;
1580    narg := Number(arg);
1581    if narg<1  or  not IsKBMAGRewritingSystemRep(arg[1]) then
1582       Error("First argument is not a rewriting system.");
1583    fi;
1584    rws := arg[1];
1585    if not IsGroupRWS(rws) then
1586      Error("AutRWS can only be applied when all generators have inverses.");
1587    fi;
1588    if IsBound(rws!.KBRun) and rws!.KBRun then
1589      Print("Knuth-Bendix has already been run on this rewriting system.\n");
1590      Print("Call - ResetRWS( <rws> ) before proceeding.\n");
1591      return;
1592    fi;
1593    if not rws!.ordering = "shortlex" then
1594       Error("AutRWS only works for shortlex ordering");
1595    fi;
1596    large:=false; filestore:=false; diff1:=false;
1597    if narg>=2 and arg[2]=true then large:=true; fi;
1598    if narg>=3 and arg[3]=true then filestore:=true; fi;
1599    if narg>=4 and arg[4]=true then diff1:=true; fi;
1600    WriteRWS(rws,_KBTmpFileName);
1601    callstring := Filename(_KBExtDir,"autgroup");
1602    optstring := " ";
1603    if large then optstring := Concatenation(optstring," -l "); fi;
1604    if filestore then optstring := Concatenation(optstring," -f "); fi;
1605    if diff1 then optstring := Concatenation(optstring," -d "); fi;
1606    if InfoLevel(InfoRWS)=0 then
1607                      optstring := Concatenation(optstring," -s "); fi;
1608    if InfoLevel(InfoRWS)>1 then
1609                      optstring := Concatenation(optstring," -v "); fi;
1610    if InfoLevel(InfoRWS)>2 then
1611                      optstring := Concatenation(optstring," -vv "); fi;
1612    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
1613    Info(InfoRWS,1,"Calling external automatic groups program.");
1614    Info(InfoRWS,3,"  ", callstring);
1615    Exec(callstring);
1616    callstring := Filename(_KBExtDir,"gpminkb");
1617    optstring := " ";
1618    if InfoLevel(InfoRWS)=0 then
1619                      optstring := Concatenation(optstring," -s "); fi;
1620    if InfoLevel(InfoRWS)>1 then
1621                      optstring := Concatenation(optstring," -v "); fi;
1622    if InfoLevel(InfoRWS)>2 then
1623                      optstring := Concatenation(optstring," -vv "); fi;
1624    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
1625    if READ(Concatenation(_KBTmpFileName,".success")) then
1626     Info(InfoRWS,1,
1627         "Computation was successful - automatic structure computed.");
1628      Info(InfoRWS,3,"  ", callstring);
1629      Exec(callstring);
1630      UpdateRWS(rws,_KBTmpFileName,false);
1631      Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1632      rws!.isAvailableNormalForm := true;
1633      rws!.isAvailableReduction := true;
1634      rws!.isAvailableSize := true;
1635      rws!.warningOn := false;
1636      return true;
1637    else
1638      Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1639      Info(InfoRWS,1,"Computation was not successful.");
1640      return false;
1641    fi;
1642end;
1643
1644#############################################################################
1645## The remaining functions in the file enable the user to to call the
1646## different parts of the automata program individually.
1647## They are experimental and less well supported than KBRUN and AutRWS.
1648#############################################################################
1649##
1650#F  KBWD(<rws>, [<haltingfactor>], [<large>])
1651##                . . . . call external Knuth-Bendix program with -wd on rws
1652##
1653##  Runs KBRUN, computes word differences, and sets the diff1 and diff2 flags
1654##  of rws to be the appropriate difference machines.
1655##  An error message results if the external program aborts without outputting.
1656##  Public function.
1657KBWD := function ( arg )
1658    local narg,rws, haltingfactor,large, callstring, optstring, mg, IdWord;
1659    narg := Number(arg);
1660    if narg<1  or  not IsKBMAGRewritingSystemRep(arg[1]) then
1661       Error("First argument is not a rewriting system.");
1662    fi;
1663    large:=false; haltingfactor:=100;
1664    rws := arg[1];
1665    if not IsGroupRWS(rws) then
1666      Error("KBWD can only be applied when all generators have inverses.");
1667    fi;
1668    if IsBound(rws!.KBRun) and rws!.KBRun then
1669      Print("Knuth-Bendix has already been run on this rewriting system.\n");
1670      Print("Call - ResetRWS( <rws> ) before proceeding.\n");
1671    fi;
1672    if narg>1 then haltingfactor := arg[2]; fi;
1673    if narg>2 then large := arg[3]; fi;
1674    WriteRWS(rws,_KBTmpFileName);
1675    callstring := Concatenation(Filename(_KBExtDir,"kbprog")," -wd -hf ");
1676    callstring := Concatenation(callstring,String(haltingfactor)," ");
1677    optstring := "";
1678    if large then
1679       optstring := Concatenation(optstring," -cn 0 -me 262144 -t 500 ");
1680    fi;
1681    if InfoLevel(InfoRWS)=0 then
1682                      optstring := Concatenation(optstring," -silent "); fi;
1683    if InfoLevel(InfoRWS)>1 then
1684                      optstring := Concatenation(optstring," -v "); fi;
1685    if InfoLevel(InfoRWS)>2 then
1686                      optstring := Concatenation(optstring," -vv "); fi;
1687    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
1688    Info(InfoRWS,1,
1689        "Calling external Knuth-Bendix program for word-differences.");
1690    Info(InfoRWS,3,"  ", callstring);
1691    Exec(callstring);
1692    Info(InfoRWS,1,"External Knuth-Bendix program complete.");
1693
1694    StoreNamesRWS(rws,_KBTmpFileName);
1695    if not READ(Concatenation(_KBTmpFileName,".diff1")) then
1696       Error("Could not open diff1 file");
1697    fi;
1698    if not READ(Concatenation(_KBTmpFileName,".diff2")) then
1699       Error("Could not open diff2 file");
1700    fi;
1701    if not READ(Concatenation(_KBTmpFileName,".kbprog.ec")) then
1702       Error("Could not open exit-code file");
1703    fi;
1704    rws!.diff1 := _RWS.diff1;
1705    rws!.diff2 := _RWS.diff2;
1706    RedefineNamesRWS(rws,_KBTmpFileName);
1707
1708    InitializeFSA(rws!.diff1);
1709    rws!.diff1.alphabet.base.printingStrings:=List(rws!.alphabet,x->String(x));
1710    rws!.diff1.states.printingStrings:=List(rws!.alphabet,x->String(x));
1711
1712    DenseDTableFSA(rws!.diff1);
1713    rws!.diff1.table.format:="dense deterministic";
1714    rws!.diff1.table.transitions:=rws!.diff1.denseDTable;
1715    Unbind(rws!.diff1.sparseTable);
1716    InitializeFSA(rws!.diff2);
1717    rws!.diff2.alphabet.base.printingStrings:=List(rws!.alphabet,x->String(x));
1718    rws!.diff2.states.printingStrings:=List(rws!.alphabet,x->String(x));
1719    DenseDTableFSA(rws!.diff2);
1720    rws!.diff2.table.format:="dense deterministic";
1721    rws!.diff2.table.transitions:=rws!.diff2.denseDTable;
1722    Unbind(rws!.diff2.sparseTable);
1723    if _ExitCode=2 then
1724      Print(
1725  "#WARNING: Knuth-Bendix program terminated with halting factor condition\n");
1726      Print("         not satisfied.\n");
1727      return false;
1728    fi;
1729    rws!.isAvailableReduction := true;
1730    rws!.warningOn := true;
1731    Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1732    return true;
1733end;
1734
1735#############################################################################
1736##
1737#F  GpWA(<rws>, [<large>], [<filestore>], [<diff1>])
1738##                      . . . . call external word-acceptor program on rws
1739##
1740##  This assumes that KBWD has already been called on rws
1741##  Public function.
1742GpWA := function ( arg )
1743    local  narg, rws, large, filestore, diff1, callstring, optstring;
1744    narg := Number(arg);
1745    if narg<1  or  not IsKBMAGRewritingSystemRep(arg[1]) then
1746       Error("First argument is not a rewriting system.");
1747    fi;
1748    rws := arg[1];
1749    if not rws!.ordering = "shortlex"  then
1750       Error("Ordering must be shortlex for external word-acceptor program");
1751    fi;
1752    large:=false; filestore:=false; diff1:=false;
1753    if narg>=2 and arg[2]=true then large:=true; fi;
1754    if narg>=3 and arg[3]=true then filestore:=true; fi;
1755    if narg>=4 and arg[4]=true then diff1:=true; fi;
1756    if diff1 then
1757      WriteFSA(
1758          rws!.diff1,"_RWS.diff1",Concatenation(_KBTmpFileName,".diff1"),";");
1759    else
1760      WriteFSA(
1761          rws!.diff2,"_RWS.diff2",Concatenation(_KBTmpFileName,".diff2"),";");
1762    fi;
1763    callstring := Filename(_KBExtDir,"gpwa");
1764    optstring := " ";
1765    if large then optstring := Concatenation(optstring," -l "); fi;
1766    if filestore then optstring := Concatenation(optstring," -f "); fi;
1767    if diff1 then optstring := Concatenation(optstring," -d "); fi;
1768    if InfoLevel(InfoRWS)=0 then
1769      optstring := Concatenation(optstring," -silent ");
1770    fi;
1771    if InfoLevel(InfoRWS)>1 then
1772      optstring := Concatenation(optstring," -v ");
1773    fi;
1774    if InfoLevel(InfoRWS)>2 then
1775      optstring := Concatenation(optstring," -vv ");
1776    fi;
1777    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
1778    Info(InfoRWS,1,"Calling external word-acceptor program.");
1779    Info(InfoRWS,3,"  ", callstring);
1780    Exec(callstring);
1781    Info(InfoRWS,1,"External word-acceptor program complete.");
1782
1783    StoreNamesRWS(rws,_KBTmpFileName);
1784    if not READ(Concatenation(_KBTmpFileName,".wa")) then
1785       Error("Could not open wa file");
1786    fi;
1787    rws!.wa := _RWS.wa;
1788    RedefineNamesRWS(rws,_KBTmpFileName);
1789
1790    InitializeFSA(rws!.wa);
1791    rws!.wa.alphabet.printingStrings:=List(rws!.alphabet,x->String(x));
1792    rws!.isAvailableSize := true;
1793    rws!.warningOn := true;
1794    Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1795end;
1796
1797#############################################################################
1798##
1799#F  GpGenMult(<rws>, [<large>], [<filestore>], [<diff1>] )
1800##                 . . . . call external generalised multiplier program on rws
1801##
1802##  This assumes that KBWD and GpWA have already been called on rws
1803##  Public function.
1804GpGenMult := function ( arg )
1805    local  narg, rws, large, filestore, diff1, callstring, optstring;
1806    narg := Number(arg);
1807    if narg<1  or  not IsKBMAGRewritingSystemRep(arg[1]) then
1808       Error("First argument is not a rewriting system.");
1809    fi;
1810    rws := arg[1];
1811    large:=false; filestore:=false; diff1:=false;
1812    if narg>=2 and arg[2]=true then large:=true; fi;
1813    if narg>=3 and arg[3]=true then filestore:=true; fi;
1814    if diff1 then
1815      WriteFSA(
1816      rws!.("diff1)"),"_RWS.diff1",Concatenation(_KBTmpFileName,".diff1"),";");
1817    fi;
1818    WriteFSA(
1819        rws!.wa,"_RWS.wa",Concatenation(_KBTmpFileName,".wa"),";");
1820    WriteFSA(
1821        rws!.diff2,"_RWS.diff2",Concatenation(_KBTmpFileName,".diff2"),";");
1822    callstring := Filename(_KBExtDir,"gpgenmult");
1823    optstring := " ";
1824    if large then optstring := Concatenation(optstring," -l "); fi;
1825    if filestore then optstring := Concatenation(optstring," -f "); fi;
1826    if diff1 then optstring := Concatenation(optstring," -c "); fi;
1827    if InfoLevel(InfoRWS)=0 then
1828                      optstring := Concatenation(optstring," -silent "); fi;
1829    if InfoLevel(InfoRWS)>1 then
1830                      optstring := Concatenation(optstring," -v "); fi;
1831    if InfoLevel(InfoRWS)>2 then
1832                      optstring := Concatenation(optstring," -vv "); fi;
1833    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
1834    Info(InfoRWS,1,"Calling external generalised multiplier program.");
1835    Info(InfoRWS,3,"  ", callstring);
1836    Exec(callstring);
1837    Info(InfoRWS,1,"External generalised-multiplier program complete.");
1838
1839    StoreNamesRWS(rws,_KBTmpFileName);
1840    if not READ(Concatenation(_KBTmpFileName,".gm")) then
1841       if diff1 then
1842         if not READ(Concatenation(_KBTmpFileName,".diff1")) then
1843           Error("Cannot read modified diff1 file.");
1844         fi;
1845         rws!.diff1 := _RWS.diff1;
1846         RedefineNamesRWS(rws,_KBTmpFileName);
1847         InitializeFSA(rws!.diff1);
1848         rws!.diff1.alphabet.base.printingStrings:=
1849                                  List(rws!.alphabet,x->String(x));
1850         rws!.diff1.states.printingStrings:=List(rws!.alphabet,x->String(x));
1851         DenseDTableFSA(rws!.diff1);
1852         rws!.diff1.table.format:="dense deterministic";
1853         rws!.diff1.table.transitions:=rws!.diff1.denseDTable;
1854         Unbind(rws!.diff1.sparseTable);
1855       fi;
1856       Print("Could not open gm file - try re-running GpWA.\n");
1857       Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1858       return false;
1859    fi;
1860    rws!.gm := _RWS.gm;
1861    RedefineNamesRWS(rws,_KBTmpFileName);
1862
1863    InitializeFSA(rws!.gm);
1864    rws!.gm.alphabet.base.printingStrings:=List(rws!.alphabet,x->String(x));
1865    rws!.gm.states.labels.printingStrings:=List(rws!.alphabet,x->String(x));
1866    Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1867    return true;
1868end;
1869
1870#############################################################################
1871##
1872#F  GpCheckMult(<rws>, [<large>], [<filestore>] )
1873##                 . . . . call external generalised multiplier program on rws
1874##
1875##  This assumes that KBWD, GpWA and GpGenMult have already been called on rws
1876##  Public function.
1877GpCheckMult := function ( arg )
1878    local  narg, rws, large, filestore, callstring, optstring;
1879    narg := Number(arg);
1880    if narg<1  or  not IsKBMAGRewritingSystemRep(arg[1]) then
1881       Error("First argument is not a rewriting system.");
1882    fi;
1883    rws := arg[1];
1884    large:=false; filestore:=false;
1885    if narg>=2 and arg[2]=true then large:=true; fi;
1886    if narg>=3 and arg[3]=true then filestore:=true; fi;
1887    WriteRWS(rws,_KBTmpFileName);
1888    WriteFSA(
1889        rws!.diff2,"_RWS.diff2",Concatenation(_KBTmpFileName,".diff2"),";");
1890    WriteFSA(
1891        rws!.gm,"_RWS.gm",Concatenation(_KBTmpFileName,".gm"),";");
1892    WriteFSA(
1893        rws!.wa,"_RWS.wa",Concatenation(_KBTmpFileName,".wa"),";");
1894    callstring := Filename(_KBExtDir,"gpcheckmult");
1895    optstring := " ";
1896    if large then optstring := Concatenation(optstring," -l "); fi;
1897    if filestore then optstring := Concatenation(optstring," -f "); fi;
1898    if rws!.ordering="wtlex" then
1899       optstring := Concatenation(optstring," -wtlex ");
1900    fi;
1901    if IsBound(rws!.options.outputWords) and rws!.options.outputWords then
1902      optstring := Concatenation(optstring," -ow ");
1903    fi;
1904    if InfoLevel(InfoRWS)=0 then
1905                      optstring := Concatenation(optstring," -silent "); fi;
1906    if InfoLevel(InfoRWS)>1 then
1907                      optstring := Concatenation(optstring," -v "); fi;
1908    if InfoLevel(InfoRWS)>2 then
1909                      optstring := Concatenation(optstring," -vv "); fi;
1910    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
1911    Info(InfoRWS,1,"Calling external multiplier checking program.");
1912    Info(InfoRWS,3,"  ", callstring);
1913    Exec(callstring);
1914    Info(InfoRWS,1,"External multiplier checking program complete.");
1915    if not READ(Concatenation(_KBTmpFileName,".cm.ec")) then
1916       Error("Could not open exit-code file");
1917    fi;
1918    if _ExitCode=2 then
1919      StoreNamesRWS(rws,_KBTmpFileName);
1920      if IsBound(rws!.options.outputWords) and rws!.options.outputWords then
1921        Print(
1922 "#Validity test on generalised multiplier failed. Reading offending words.\n");
1923        if not READ(Concatenation(_KBTmpFileName,".wg")) then
1924          Error("Could not open wg file");
1925        fi;
1926        rws!.wg := _RWS.wg;
1927        RedefineNamesRWS(rws,_KBTmpFileName);
1928        Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1929        return false;
1930      fi;
1931      Print(
1932       "#Validity test on generalised multiplier failed. Re-run GpGenMult.\n");
1933      if not READ(Concatenation(_KBTmpFileName,".diff2")) then
1934         Error("Could not open diff2 file");
1935      fi;
1936      rws!.diff2 := _RWS.diff2;
1937      RedefineNamesRWS(rws,_KBTmpFileName);
1938      InitializeFSA(rws!.diff2);
1939      rws!.diff2.alphabet.base.printingStrings:=List(rws!.alphabet,x->String(x));
1940      rws!.diff2.states.printingStrings:=List(rws!.alphabet,x->String(x));
1941      DenseDTableFSA(rws!.diff2);
1942      rws!.diff2.table.format:="dense deterministic";
1943      rws!.diff2.table.transitions:=rws!.diff2.denseDTable;
1944      Unbind(rws!.diff2.sparseTable);
1945      Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1946      return false;
1947    fi;
1948    Print(
1949       "#Validity test on generalised multiplier passed.\n");
1950    Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
1951    return true;
1952end;
1953
1954#############################################################################
1955##
1956#F  ElimGenRWS(<rws>, <gen>, <w> )
1957##                 . . . . eliminate a generator in an rws
1958##
1959##  This is for the case when a generator in an rws reduces to a word of
1960##  length greater than one in the ordering being used.
1961##  The generator is marked as having no inverse (to prevent the inverse
1962##  relations being processed), and in all other relations in the rws it is
1963##  eliminated by substituting w for it.
1964##  Public function.
1965ElimGenRWS := function ( rws, gen, w )
1966    local rwsc, gens, genno, wl, ig, igenno, eqn, i, side;
1967    rwsc := ShallowCopy(rws);
1968    rwsc!.invAlphabet := ShallowCopy(rws!.invAlphabet);
1969    rwsc!.equations := StructuralCopy(rws!.equations);
1970    gens := rwsc!.alphabet;
1971    genno := Position(gens,gen);
1972    if genno=fail then
1973       Error("Invalid generator");
1974    fi;
1975    wl := ShallowCopy(WordToListRWS(w,rwsc!.alphabet));
1976    eqn:=[];
1977    ig := rwsc!.invAlphabet;
1978    igenno := ig[genno];
1979    if igenno <> 0 then
1980      #Add relations that say that these two generators are mutually
1981      #inverse.
1982      if genno=igenno then
1983        ig[genno] := 0;
1984        eqn[1]:=Concatenation(wl,wl); eqn[2]:=[];
1985        Add(rwsc!.equations,eqn);
1986      else
1987        ig[genno] := 0;
1988        ig[igenno] := 0;
1989        eqn[1]:=Concatenation([igenno],wl); eqn[2]:=[];
1990        Add(rwsc!.equations,eqn);
1991        eqn:=[];
1992        eqn[1]:=Concatenation(wl,[igenno]); eqn[2]:=[];
1993        Add(rwsc!.equations,eqn);
1994      fi;
1995    fi;
1996    #Now do the substitutions in the other equations
1997    for eqn in rwsc!.equations do
1998      i:=1;
1999      while i<=Length(eqn[1]) do
2000        if eqn[1][i]=genno then
2001          SubstitutedListFSA(eqn[1],i,i,wl);
2002        fi;
2003        i := i+1;
2004      od;
2005      i:=1;
2006      while i<=Length(eqn[2]) do
2007        if eqn[2][i]=genno then
2008          SubstitutedListFSA(eqn[2],i,i,wl);
2009        fi;
2010        i := i+1;
2011      od;
2012      #Now do free reduction
2013      for side in [eqn[1],eqn[2]] do
2014        i:=1;
2015        while i < Length(side) do
2016          if side[i+1]=ig[side[i]] then
2017            SubstitutedListFSA(side,i,i+1,[]);
2018            if i>1 then i:=i-1; fi;
2019          else i:=i+1;
2020          fi;
2021        od;
2022      od;
2023    od;
2024    #finally eliminate any repetitions
2025    rwsc!.equations := Set(rwsc!.equations);
2026    for eqn in rwsc!.equations do
2027      if eqn[1]=eqn[2] then
2028        RemoveSet(rwsc!.equations,eqn);
2029      fi;
2030    od;
2031    return rwsc;
2032end;
2033
2034#############################################################################
2035##
2036#F  GpAxioms(<rws>, [<large>], [<filestore>] )
2037##                 . . . . call external axiom checking program on rws
2038##
2039##  This assumes that KBWD, GpWA, GpGenMult and GpCheckMult have already
2040##  been called on rws
2041##  Public function.
2042GpAxioms := function ( arg )
2043    local  narg, rws, large, filestore, callstring, optstring;
2044    narg := Number(arg);
2045    if narg<1  or  not IsKBMAGRewritingSystemRep(arg[1]) then
2046       Error("First argument is not a rewriting system.");
2047    fi;
2048    rws := arg[1];
2049    large:=false; filestore:=false;
2050    if narg>=2 and arg[2]=true then large:=true; fi;
2051    if narg>=3 and arg[3]=true then filestore:=true; fi;
2052    WriteRWS(rws,_KBTmpFileName);
2053    WriteFSA(
2054          rws!.gm,"_RWS.gm",Concatenation(_KBTmpFileName,".gm"),";");
2055    callstring := Filename(_KBExtDir,"gpaxioms");
2056    optstring := " ";
2057    if IsBound(rws!.sub) then
2058      WriteRWS(rws!.sub,Concatenation(_KBTmpFileName,"_x"));
2059      optstring := Concatenation(optstring," -x ");
2060    fi;
2061    if large then optstring := Concatenation(optstring," -l "); fi;
2062    if filestore then optstring := Concatenation(optstring," -f "); fi;
2063    #gpaxioms no longer needs a -wtlex flag, so omit following 3 lines.
2064    #if rws!.ordering="wtlex" then
2065    #   optstring := Concatenation(optstring," -wtlex ");
2066    #fi;
2067    if InfoLevel(InfoRWS)=0 then
2068                      optstring := Concatenation(optstring," -silent "); fi;
2069    if InfoLevel(InfoRWS)>1 then
2070                      optstring := Concatenation(optstring," -v "); fi;
2071    if InfoLevel(InfoRWS)>2 then
2072                      optstring := Concatenation(optstring," -vv "); fi;
2073    callstring := Concatenation(callstring,optstring,_KBTmpFileName);
2074    Info(InfoRWS,1,"Calling external axiom checking program.");
2075    Info(InfoRWS,3,"  ", callstring);
2076    Exec(callstring);
2077    Info(InfoRWS,1,"External axiom checking program complete.");
2078    if not READ(Concatenation(_KBTmpFileName,".axioms.ec")) then
2079       Error("Could not open exit-code file");
2080    fi;
2081    if _ExitCode=2 then
2082      Print(
2083       "#Axiom checking failed.\n");
2084      return false;
2085    fi;
2086    Print(
2087       "#Axiom checking succeeded.\n");
2088    rws!.warningOn:=false;
2089    Exec(Concatenation("/bin/rm -f ",_KBTmpFileName,"*"));
2090    return true;
2091end;
2092
2093#############################################################################
2094##
2095#F  CommutativeRWS(<rws>)
2096##                 . . . . add extra equations to an RWS to make commutative
2097##
2098##  This procedure simply adds relations to the rewriting system <rws> to
2099##  make each pair of generators commute.
2100##  Public function.
2101CommutativeRWS := function(rws)
2102    local ng, i, j;
2103    if not IsKBMAGRewritingSystemRep(rws)  then
2104       Error("Argument is not an internal rewriting system.");
2105    fi;
2106    ng := Length(rws!.alphabet);
2107    for i in [1..ng] do for j in [1..i-1] do
2108      Add(rws!.equations,[[i,j],[j,i]]);
2109    od; od;
2110end;
2111