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