1############################################################################# 2## 3#W mealy.gi Laurent Bartholdi 4## 5#Y Copyright (C) 2006-2013, Laurent Bartholdi 6## 7############################################################################# 8## 9## This file implements the category of Mealy machines and elements. 10## 11############################################################################# 12 13############################################################################# 14## 15#O InitialState(<MealyMachine>) 16## 17InstallMethod(InitialState, "(FR) for a Mealy machine", 18 [IsMealyElement], 19 M->M!.initial); 20############################################################################ 21 22############################################################################ 23## 24#O Output(<MealyMachine>, <State>) 25#O Transition(<MealyMachine>, <State>, <Input>) 26#O Activity(<MealyElement>[, <Level>]) 27#O WreathRecursion(<MealyElement>) 28## 29BindGlobal("DOMALPHABET@", function(M) 30 local a; 31 a := AlphabetOfFRObject(M); 32 if IsDomain(a) then return a; else return Domain(a); fi; 33end); 34 35InstallMethod(Output, "(FR) for a Mealy machine", 36 [IsMealyMachine and IsMealyMachineIntRep], 37 function(M) 38 return M!.output; 39end); 40 41InstallMethod(Output, "(FR) for a Mealy machine and a state", 42 [IsMealyMachine and IsMealyMachineIntRep, IsInt], 43 function(M, s) 44 return M!.output[s]; 45end); 46 47InstallMethod(Output, "(FR) for a Mealy machine, a state and a letter", 48 [IsMealyMachine and IsMealyMachineIntRep, IsInt, IsInt], 49 function(M, s, a) 50 return M!.output[s][a]; 51end); 52 53InstallMethod(Output, "(FR) for a Mealy machine", 54 [IsMealyMachine and IsMealyMachineDomainRep], 20, 55 function(M) 56 return s->MappingByFunction(DOMALPHABET@(M), DOMALPHABET@(M), 57 a->M!.output(s,a)); 58end); 59 60InstallMethod(Output, "(FR) for a Mealy machine and a state", 61 [IsMealyMachine and IsMealyMachineDomainRep, IsObject], 20, 62 function(M, s) 63 return MappingByFunction(DOMALPHABET@(M), DOMALPHABET@(M), 64 a->M!.output(s,a)); 65end); 66 67InstallMethod(Output, "(FR) for a Mealy machine, a state and a letter", 68 [IsMealyMachine and IsMealyMachineDomainRep, IsObject, IsObject], 69 function(M, s, a) 70 return M!.output(s,a); 71end); 72 73InstallMethod(Output, "(FR) for a Mealy element", 74 [IsMealyElement and IsMealyMachineIntRep], 75 E->E!.output[E!.initial]); 76 77InstallMethod(Output, "(FR) for a Mealy element and input", 78 [IsMealyElement and IsMealyMachineIntRep, IsInt], 79 function(E, i) 80 return E!.output[E!.initial][i]; 81end); 82 83InstallMethod(Output, "(FR) for a Mealy machine, a state and a letter", 84 [IsMealyElement and IsMealyMachineIntRep, IsInt, IsInt], 85 function(E, s, a) 86 return E!.output[s][a]; 87end); 88 89InstallMethod(Output, "(FR) for a Mealy element", 90 [IsMealyElement and IsMealyMachineDomainRep], 91 function(E) 92 return MappingByFunction(DOMALPHABET@(E), DOMALPHABET@(E), 93 a->E!.output(E!.initial,a)); 94end); 95 96InstallMethod(Output, "(FR) for a Mealy element and object", 97 [IsMealyElement and IsMealyMachineDomainRep,IsObject], 98 function(E,a) 99 return E!.output(E!.initial,a); 100end); 101 102InstallMethod(Output, "(FR) for a Mealy element, a state and a letter", 103 [IsMealyElement and IsMealyMachineDomainRep, IsObject, IsObject], 104 function(E, s, a) 105 return E!.output(s,a); 106end); 107 108InstallMethod(Transition, "(FR) for a Mealy machine, state, and input", 109 [IsMealyMachine and IsMealyMachineIntRep, IsInt, IsInt], 110 function(M, s, i) 111 return M!.transitions[s][i]; 112end); 113 114InstallMethod(Transition, "(FR) for a Mealy machine, state, and input", 115 [IsMealyMachine and IsMealyMachineDomainRep, IsObject, IsObject], 40, 116 function(M, s, i) 117 return M!.transitions(s,i); 118end); 119 120InstallMethod(Transition, "(FR) for a Mealy element, state, and input", 121 [IsMealyElement and IsMealyMachineIntRep, IsInt, IsInt], 122 function(M, s, i) 123 return M!.transitions[s][i]; 124end); 125 126InstallMethod(Transition, "(FR) for a Mealy element, state, and input", 127 [IsMealyElement and IsMealyMachineDomainRep, IsObject, IsObject], 40, 128 function(M, s, i) 129 return M!.transitions(s,i); 130end); 131 132InstallMethod(Transition, "(FR) for a Mealy element and input", 133 [IsMealyElement and IsMealyMachineIntRep, IsInt], 134 function(M, i) 135 return M!.transitions[M!.initial][i]; 136end); 137 138InstallMethod(Transition, "(FR) for a Mealy element and input", 139 [IsMealyElement and IsMealyMachineDomainRep, IsObject], 20, 140 function(M, i) 141 return M!.transitions(M!.initial,i); 142end); 143 144InstallMethod(Transitions, "(FR) for a Mealy machine and state", 145 [IsMealyMachine and IsMealyMachineIntRep, IsInt], 146 function(M, s) 147 return M!.transitions[s]; 148end); 149 150InstallMethod(Transitions, "(FR) for a Mealy machine and state", 151 [IsMealyMachine and IsMealyMachineDomainRep, IsObject], 40, 152 function(M, s) 153 return i->M!.transitions(s,i); 154end); 155 156InstallMethod(Transitions, "(FR) for a Mealy element and state", 157 [IsMealyElement and IsMealyMachineIntRep, IsInt], 158 function(M, s) 159 return M!.transitions[s]; 160end); 161 162InstallMethod(Transitions, "(FR) for a Mealy element and state", 163 [IsMealyElement and IsMealyMachineDomainRep, IsObject], 40, 164 function(M, s) 165 return i->M!.transitions(s,i); 166end); 167 168InstallMethod(Transitions, "(FR) for a Mealy element", 169 [IsMealyElement and IsMealyMachineIntRep], 170 function(M) 171 return M!.transitions[M!.initial]; 172end); 173 174InstallMethod(Transitions, "(FR) for a Mealy element", 175 [IsMealyElement and IsMealyMachineDomainRep], 20, 176 function(M) 177 return i->M!.transitions(M!.initial,i); 178end); 179 180BindGlobal("MMACTIVITY@", function(E,l) 181 local d, i, r, s; 182 d := Size(AlphabetOfFRObject(E)); 183 r := List([1..E!.nrstates], i->[1]); 184 for i in [1..l] do 185 r := List([1..E!.nrstates], s->Concatenation(List(AlphabetOfFRObject(E), 186 x->r[E!.transitions[s][x]]+d^(i-1)*(E!.output[s][x]-1)))); 187 od; 188 return r; 189end); 190 191InstallMethod(Activity, "(FR) for a Mealy element and a level", 192 [IsMealyElement, IsInt], 193 function(E,l) 194 return PERMORTRANSFORMATION@(Transformation(MMACTIVITY@(E,l)[E!.initial])); 195end); 196 197InstallMethod(ActivityTransformation, "(FR) for a Mealy element and a level", 198 [IsMealyElement, IsInt], 199 function(E,l) 200 return Transformation(MMACTIVITY@(E,l)[E!.initial]); 201end); 202 203InstallMethod(ActivityPerm, "(FR) for a Mealy element and a level", 204 [IsMealyElement, IsInt], 205 function(E,l) 206 return PermList(MMACTIVITY@(E,l)[E!.initial]); 207end); 208 209InstallMethod(\^, "(FR) for an integer and a Mealy element", 210 [IsPosInt, IsMealyElement and IsMealyMachineIntRep], 211 function(p,E) 212 return E!.output[E!.initial][p]; 213end); 214 215InstallOtherMethod(\^, "(FR) for an integer and a Mealy element", 216 [IsObject, IsMealyElement and IsMealyMachineDomainRep], 217 function(p,E) 218 return E!.output(E!.initial,p); 219end); 220 221InstallMethod(DecompositionOfFRElement, "(FR) for a Mealy element", 222 [IsMealyElement], 223 function(E) 224 return [List(AlphabetOfFRObject(E),a->FRElement(E,E!.transitions[E!.initial][a])),Output(E)]; 225end); 226 227InstallMethod(WreathRecursion, "(FR) for a Mealy machine", 228 [IsMealyMachine], 229 M->(i->[M!.transitions[i],M!.output[i]])); 230############################################################################ 231 232############################################################################ 233## 234#O States(MealyMachine[, Initial]) 235#O States(MealyElement) 236## 237 238InstallMethod(StateSet, "(FR) for a Mealy machine", 239 [IsMealyMachine and IsMealyMachineIntRep], 240 M->[1..M!.nrstates]); 241 242InstallMethod(StateSet, "(FR) for a Mealy machine", 243 [IsMealyMachine and IsMealyMachineDomainRep], 244 M->M!.states); 245 246InstallMethod(StateSet, "(FR) for a Mealy element", 247 [IsMealyElement and IsMealyMachineIntRep], 248 E->[1..E!.nrstates]); 249 250InstallMethod(StateSet, "(FR) for a Mealy element", 251 [IsMealyElement and IsMealyMachineDomainRep], 252 function(E) 253 local r, oldr, i; 254 oldr := []; 255 r := [E!.initial]; 256 repeat 257 i := Difference(r,oldr); 258 oldr := r; 259 for i in i do 260 r := Union(r,List(AlphabetOfFRObject(E),a->E!.transitions(i,a))); 261 od; 262 until oldr = r; 263 return r; 264end); 265 266InstallMethod(GeneratorsOfFRMachine, "(FR) for a Mealy machine", 267 [IsMealyMachine], StateSet); 268 269BindGlobal("MEALYLIMITSTATES@", function(M) 270 local R, oldR, i, a; 271 R := BlistList([1..M!.nrstates],[1..M!.nrstates]); 272 repeat 273 oldR := R; 274 R := BlistList([1..M!.nrstates],[]); 275 for i in [1..M!.nrstates] do if oldR[i] then 276 for a in AlphabetOfFRObject(M) do R[M!.transitions[i][a]] := true; od; 277 fi; od; 278 until oldR=R; 279 return ListBlist([1..M!.nrstates],R); 280end); 281 282InstallMethod(LimitStatesOfFRMachine, "(FR) for a Mealy machine", 283 [IsMealyMachine and IsMealyMachineIntRep], 284 M->List(MEALYLIMITSTATES@(M),i->FRElement(M,i))); 285InstallMethod(LimitStates, "(FR) for a Mealy machine", 286 [IsMealyMachine and IsMealyMachineIntRep], 287 LimitStatesOfFRMachine); 288 289InstallMethod(LimitStatesOfFRElement, "(FR) for a Mealy element", 290 [IsMealyElement and IsMealyMachineIntRep], 291 E->List(MEALYLIMITSTATES@(E),i->FRElement(E,i))); 292 293InstallOtherMethod(State, "(FR) for a Mealy element and an integer", 294 [IsMealyElement, IsInt], 295 function(E,a) 296 return FRElement(E,Transition(E,a)); 297end); 298 299InstallOtherMethod(State, "(FR) for a Mealy element and a list", 300 [IsMealyElement, IsList], 301 function(E,a) 302 local s; 303 s := InitialState(E); 304 for a in a do 305 s := Transition(E,s,a); 306 od; 307 return FRElement(E,s); 308end); 309 310InstallMethod(States, "(FR) for a Mealy element", 311 [IsMealyElement], 312 E->List(StateSet(E),s->FRElement(E,s))); 313 314InstallMethod(FixedRay, "(FR) for a Mealy element", 315 [IsMealyElement and IsMealyMachineIntRep], 316 function(e) 317 local f, recur, state, ray; 318 f := List([1..e!.nrstates],s->Reversed(Filtered(AlphabetOfFRObject(e),a->e!.output[s][a]=a))); 319 state := []; 320 ray := []; 321 recur := function(s,e,state,ray) 322 local i; 323 i := Position(state,s); 324 if i<>fail then 325 return CompressedPeriodicList(ray,i); 326 fi; 327 Add(state,s); 328 while f[s]<>[] do 329 i := Remove(f[s]); 330 Add(ray,i); 331 i := recur(e!.transitions[s][i],e,state,ray); 332 if i<>fail then return i; fi; 333 Remove(ray); 334 od; 335 Remove(state); 336 return fail; 337 end; 338 return recur(e!.initial,e,state,ray); 339end); 340############################################################################ 341 342############################################################################ 343## 344#M Minimized . . . . . . . . . . . . . . . . . . . . minimize Mealy machine 345## 346# mode=0 means normal 347# mode=1 means all states are known to be accessible 348# mode=2 means all states are known to be distinct and accessible 349BindGlobal("MMMINIMIZE@", function(fam,alphabet,nrstates,transitions,output,initial,mode) 350 local a, sn, snart, part, trap, i, j, x, y, p, ci, todo, states; 351 352 if initial<>fail and mode=0 then 353 todo := [initial]; 354 states := BlistList([1..nrstates],todo); 355 for i in todo do 356 for a in alphabet do 357 x := transitions[i][a]; 358 if not states[x] then states[x] := true; Add(todo,x); fi; 359 od; 360 od; 361 states := ListBlist([1..nrstates],states); 362 else 363 states := [1..nrstates]; 364 fi; 365 366 if mode<=1 then 367 a := NewDictionary(output[1],true); 368 part := []; 369 for i in states do 370 x := output[i]; 371 y := LookupDictionary(a,x); 372 if y=fail then 373 Add(part,[i]); 374 AddDictionary(a,x,Length(part)); 375 else 376 Add(part[y],i); 377 fi; 378 od; 379 Sort(part,function(a,b) return Length(a)<Length(b); end); 380 381 trap := []; 382 for i in [1..Length(part)] do for j in part[i] do trap[j] := i; od; od; 383 # inverse lookup in part 384 385 snart := []; 386 for a in alphabet do 387 sn := []; 388 for i in states do 389 j := transitions[i][a]; 390 if IsBound(sn[j]) then 391 Add(sn[j],i); 392 else 393 sn[j] := [i]; 394 fi; 395 od; 396 for i in states do 397 if IsBound(sn[i]) then Sort(sn[i]); fi; 398 od; 399 Add(snart, sn); 400 od; 401 # reverse lookup in trans, with indices swapped: 402 # snart[letter][state] = { i: trans[i][letter] = state } 403 404 todo := [1..Length(part)-1]; 405 i := 1; 406 while i <= Length(todo) do 407 for a in alphabet do 408 ci := []; 409 for j in part[todo[i]] do 410 if IsBound(snart[a][j]) then Append(ci,snart[a][j]); fi; 411 od; 412 if Length(ci) = 0 or Length(ci) = Length(states) then continue; fi; 413 ci := AsSortedList(ci); 414 for j in Set(trap{ci}) do 415 p := part[j]; 416 if Length(part[j]) > 1 then 417 x := Intersection(p,ci); 418 if Length(x) <> 0 and Length(x) <> Length(p) then 419 y := Difference(p,x); 420 if Length(y) > Length(x) then 421 part[j] := y; 422 Add(part,x); 423 for y in x do trap[y] := Length(part); od; 424 else 425 part[j] := x; 426 Add(part,y); 427 for x in y do trap[x] := Length(part); od; 428 fi; 429 Add(todo,Length(part)); 430 fi; 431 fi; 432 od; 433 od; 434 i := i+1; 435 od; 436 else 437 trap := states; 438 fi; 439 440 if initial<>fail then 441 x := []; y := []; 442 todo := [initial]; 443 for i in todo do 444 if not IsBound(x[trap[i]]) then 445 Add(y,i); 446 x[trap[i]] := Length(y); 447 Append(todo,transitions[i]); 448 fi; 449 od; 450 a := MealyElementNC(fam, 451 List(transitions{y},row->List(row,i->x[trap[i]])), 452 output{y},1); 453 y := ListWithIdenticalEntries(Maximum(states)+1,Maximum(states)+1); 454 for i in states do 455 if IsBound(x[trap[i]]) then y[i] := x[trap[i]]; fi; 456 od; 457 SetCorrespondence(a,Transformation(y)); 458 else 459 y := List(part,i->i[1]); 460 a := MealyMachineNC(fam, 461 List(transitions{y},row->List(row,i->trap[i])), 462 output{y}); 463 SetCorrespondence(a,Transformation(trap)); 464 fi; 465 return a; 466end); 467 468InstallMethod(Minimized, "(FR) for a Mealy machine in int rep", 469 [IsMealyMachine and IsMealyMachineIntRep], 470 function(M) 471 if M!.output=[] then 472 return M; 473 else 474 return MMMINIMIZE@(FamilyObj(M),AlphabetOfFRObject(M), 475 M!.nrstates,M!.transitions,M!.output,fail,0); 476 fi; 477end); 478 479InstallMethod(Minimized, "(FR) for a Mealy element in int rep", 480 [IsMealyElement and IsMealyMachineIntRep], 481 E->MMMINIMIZE@(FamilyObj(E),AlphabetOfFRObject(E), 482 E!.nrstates,E!.transitions,E!.output,E!.initial,0)); 483 484InstallMethod(Minimized, "(FR) for a Mealy machine in domain rep", 485 [IsMealyMachine and IsMealyMachineDomainRep], 486 M->Error("Cannot minimize Mealy machine on domain")); 487 488InstallMethod(Minimized, "(FR) for a Mealy element in domain rep", 489 [IsMealyElement and IsMealyMachineDomainRep], 490 M->Error("Cannot minimize Mealy element on domain")); 491 492InstallMethod(SubFRMachine, "(FR) for two Mealy machines", 493 [IsMealyMachine and IsMealyMachineIntRep, 494 IsMealyMachine and IsMealyMachineIntRep], 495 function(M,N) 496 local s, c; 497 if AlphabetOfFRObject(N)<>AlphabetOfFRObject(M) then 498 return fail; 499 fi; 500 s := M+N; 501 c := Minimized(s); 502 c := ListTransformation(Correspondence(c),s!.nrstates); 503 s := [ListTransformation(Correspondence(s)[1],M!.nrstates), 504 ListTransformation(Correspondence(s)[2],N!.nrstates)]; 505 if IsSubset(c{s[1]},c{s[2]}) then 506 return Transformation(StateSet(N),i->First(StateSet(M),j->c[s[1][j]]=c[s[2][i]])); 507 else 508 return fail; 509 fi; 510end); 511############################################################################ 512 513############################################################################ 514## 515#O MealyMachine(<Transitions>, <Output> [,<Initial>]) 516#O MealyMachine(<Alphabet>, <Transitions>, <Output> [,<Initial]) 517#O MealyMachine(<Stateset>, <Alphabet>, <Transitions>, <Output> [,<Initial>]) 518## 519InstallMethod(MealyMachineNC, "(FR) for a family and two matrices", 520 [IsFamily, IsMatrix, IsMatrix], 521 function(f, transitions, output) 522 return Objectify(NewType(f, IsMealyMachine and IsMealyMachineIntRep), 523 rec(nrstates := Length(transitions), 524 transitions := transitions, 525 output := output)); 526end); 527 528InstallMethod(MealyElementNC, "(FR) for a family, two matrices and an initial state", 529 [IsFamily, IsMatrix, IsMatrix, IsInt], 530 function(f, transitions, output, initial) 531 return Objectify(NewType(f, IsMealyElement and IsMealyMachineIntRep), 532 rec(nrstates := Length(transitions), 533 transitions := transitions, 534 output := output, 535 initial := initial)); 536end); 537 538BindGlobal("MEALYMACHINEINT@", function(transitions, output, initial) 539 local F, nrstates, i, out, inv; 540 if Length(transitions)<>Length(output) then 541 Error("<Transitions> and <Output> must have the same length\n"); 542 fi; 543 nrstates := Length(transitions); 544 if not ForAll(transitions, IsList) or 545 ForAny(transitions, r->Length(r)<>Length(transitions[1])) then 546 Error("All rows of <Transitions> must be lists of the same length\n"); 547 fi; 548 if initial<>fail then 549 F := FREFamily([1..Length(transitions[1])]); 550 else 551 F := FRMFamily([1..Length(transitions[1])]); 552 fi; 553 if ForAny(transitions, x->ForAny(x, i->not i in [1..nrstates])) then 554 Error("An entry of <Transitions> is not in the state set\n"); 555 fi; 556 out := List(output,x->ANY2OUT@(x,Size(F!.alphabet))); 557 inv := ForAll(out,ISINVERTIBLE@); 558 if ForAny(out, x->not IsSubset(F!.alphabet, x)) then 559 Error("An entry of <Output> is not in the alphabet\n"); 560 fi; 561 ConvertToRangeRep(F!.alphabet); 562 #!!! a bug in GAP, range rep is destroyed by IsSubset 563 564 i := rec(nrstates := nrstates, 565 transitions := transitions, 566 output := out); 567 568 if initial<>fail then 569 i.initial := initial; 570 i := Objectify(NewType(F, IsMealyElement and IsMealyMachineIntRep), i); 571 i := Minimized(i); 572 else 573 i := Objectify(NewType(F, IsMealyMachine and IsMealyMachineIntRep), i); 574 fi; 575 SetIsInvertible(i, inv); 576 577 return i; 578end); 579 580InstallMethod(MealyMachine, "(FR) for a matrix and a list", 581 [IsMatrix, IsList], 582 function(t, o) return MEALYMACHINEINT@(t, o, fail); end); 583 584InstallMethod(MealyElement, "(FR) for a matrix, a list and a state", 585 [IsMatrix, IsList, IsInt], 586 function(t, o, s) return MEALYMACHINEINT@(t, o, s); end); 587 588BindGlobal("MEALYMACHINEDOM@", function(alphabet, transitions, output, has_init, initial) 589 local F, out, trans, i, t; 590 if has_init then 591 F := FREFamily(alphabet); 592 else 593 F := FRMFamily(alphabet); 594 fi; 595 if Length(transitions)<>Length(output) then 596 Error("<Transitions> and <Output> must have the same length\n"); 597 fi; 598 if ForAny(output,IsList) and 599 HasSize(alphabet) and Size(alphabet)<>Length(First(output,IsList)) then 600 Error("<Domain> and <Output> must have the same size\n"); 601 fi; 602 if F!.standard then 603 trans := []; 604 for i in transitions do 605 if IsFunction(i) then 606 Add(trans, List(alphabet, i)); 607 elif IsList(i) then 608 Add(trans, i); 609 else 610 Add(trans, List(alphabet, y->y^i)); 611 fi; 612 od; 613 out := []; 614 for i in output do 615 if IsFunction(i) then 616 Add(out, MappingByFunction(alphabet, alphabet, i)); 617 else 618 Add(out, ANY2OUT@(i,Size(alphabet))); 619 fi; 620 od; 621 t := IsMealyMachineIntRep; 622 i := rec(nrstates := Length(transitions), 623 transitions := trans, 624 output := out); 625 else 626 trans := function(s,a) 627 local newa; 628 newa := F!.a2n(a); 629 if IsFunction(transitions[s]) then 630 return transitions[s](newa); 631 elif IsList(transitions[s]) then 632 return transitions[s][newa]; 633 else 634 return newa^transitions[s]; 635 fi; 636 end; 637 out := function(s,a) 638 local newa; 639 newa := F!.a2n(a); 640 if IsFunction(output[s]) then 641 newa := output[s](newa); 642 else 643 newa := output[s][newa]; 644 fi; 645 return F!.n2a(newa); 646 end; 647 t := IsMealyMachineDomainRep; 648 i := rec(states := [1..Length(transitions)], 649 transitions := trans, 650 output := out); 651 fi; 652 if has_init then 653 i!.initial := initial; 654 i := Objectify(NewType(F, IsMealyElement and t), i); 655 if t = IsMealyMachineIntRep then 656 i := Minimized(i); 657 fi; 658 else 659 i := Objectify(NewType(F, IsMealyMachine and t), i); 660 fi; 661 return i; 662end); 663 664InstallMethod(MealyMachine, "(FR) for an alphabet and two lists", 665 [IsDomain, IsList, IsList], 666 function(a, t, o) return MEALYMACHINEDOM@(a, t, o, false, 0); end); 667 668InstallMethod(MealyElement, "(FR) for an alphabet, two lists and a state", 669 [IsDomain, IsList, IsList, IsInt], 670 function(a, t, o, s) return MEALYMACHINEDOM@(a, t, o, true, s); end); 671 672InstallMethod(MealyMachine, "(FR) for alphabet, stateset and two functions", 673 [IsDomain, IsDomain, IsFunction, IsFunction], 674 function(stateset, alphabet, transitions, output) 675 local F; 676 F := FRMFamily(alphabet); 677 return Objectify(NewType(F, IsMealyMachine and IsMealyMachineDomainRep), 678 rec(states := stateset, 679 transitions := transitions, 680 output := output)); 681end); 682 683InstallMethod(MealyElement, "(FR) for alphabet, stateset, two functions and a state", 684 [IsDomain, IsDomain, IsFunction, IsFunction, IsObject], 20, 685 function(stateset, alphabet, transitions, output, s) 686 local F; 687 F := FREFamily(alphabet); 688 689 return Objectify(NewType(F, IsMealyElement and IsMealyMachineDomainRep), 690 rec(states := stateset, 691 transitions := transitions, 692 output := output, 693 initial := s)); 694end); 695 696InstallMethod(FRElement, "(FR) for a Mealy machine and a state", 697 [IsMealyMachine and IsMealyMachineIntRep, IsInt], 698 function(M,s) 699 return MMMINIMIZE@(FREFamily(M),AlphabetOfFRObject(M), 700 M!.nrstates,M!.transitions,M!.output,s,0); 701end); 702 703InstallMethod(FRElement, "(FR) for a Mealy element and a state", 704 [IsMealyElement and IsMealyMachineIntRep, IsInt], 705 function(E,s) 706 return MMMINIMIZE@(FamilyObj(E),AlphabetOfFRObject(E), 707 E!.nrstates,E!.transitions,E!.output,s,2); 708end); 709 710InstallMethod(FRElement, "(FR) for a Mealy machine and a list of states", 711 [IsMealyMachine and IsMealyMachineIntRep, IsList], 712 function(M,l) 713 return Product(List(l,i->FRElement(M,i))); 714end); 715 716InstallMethod(FRElement, "(FR) for a Mealy element and a list of states", 717 [IsMealyElement and IsMealyMachineIntRep, IsList], 718 function(E,l) 719 return Product(List(l,i->FRElement(E,i))); 720end); 721 722InstallMethod(FRElement, "(FR) for a Mealy machine and a state", 723 [IsMealyMachine and IsMealyMachineDomainRep, IsObject], 724 function(M,s) 725 return Objectify(NewType(FREFamily(M), IsMealyElement and 726 IsMealyMachineDomainRep), 727 rec(states := M!.states, 728 transitions := M!.transitions, 729 output := M!.output, 730 initial := s)); 731end); 732 733InstallMethod(FRElement, "(FR) for a Mealy element and a state", 734 [IsMealyElement and IsMealyMachineDomainRep, IsObject], 735 function(E,s) 736 return Objectify(NewType(FamilyObj(E), IsMealyElement and 737 IsMealyMachineDomainRep), 738 rec(states := E!.states, 739 transitions := E!.transitions, 740 output := E!.output, 741 initial := s)); 742end); 743 744BindGlobal("COMPOSEELEMENT@", function(l,p) 745 local m, i, init; 746 if ForAll(l,IsMealyElement) then 747 m := MealyMachineNC(FRMFamily(l[1]),[List(l,x->1)],[p]); 748 init := 1; 749 for i in [1..Length(l)] do 750 m := m+UnderlyingFRMachine(l[i]); 751 init := init^Correspondence(m)[1]; 752 m!.transitions[init][i] := InitialState(l[i])^Correspondence(m)[2]; 753 od; 754 return FRElement(m,init); 755 else 756 return FRElement([List(l,x->[x])],[p],[1]); 757 fi; 758end); 759 760InstallMethod(ComposeElement, "(FR) for a list of elements and a permutation", 761 [IsFRElementCollection, IsObject], 762 function(l,p) 763 return COMPOSEELEMENT@(l,ANY2OUT@(p,Size(AlphabetOfFRObject(l[1])))); 764end); 765 766InstallMethod(ComposeElement, "(FR) for a list of elements and a list", 767 [IsFRElementCollection, IsList], 768 COMPOSEELEMENT@); 769 770InstallMethod(VertexElement, "(FR) for a vertex index and a Mealy element", 771 [IsPosInt, IsMealyElement], 772 function(v,E) 773 local m; 774 m := MealyMachineNC(FRMFamily(E),[List(AlphabetOfFRObject(E),x->2),List(AlphabetOfFRObject(E),x->2)],[AlphabetOfFRObject(E),AlphabetOfFRObject(E)])+UnderlyingFRMachine(E); 775 m!.transitions[1^Correspondence(m)[1]][v] := InitialState(E)^Correspondence(m)[2]; 776 return FRElement(m,1^Correspondence(m)[1]); 777end); 778 779InstallMethod(DiagonalElement, "(FR) for a power and a Mealy element", 780 [IsInt, IsMealyElement], 781 function(n,E) 782 return ComposeElement(List([0..Size(AlphabetOfFRObject(E))-1],i->E^((-1)^i*Binomial(n,i))),AlphabetOfFRObject(E)); 783end); 784 785InstallMethod(UnderlyingFRMachine, "(FR) for a Mealy element", 786 [IsMealyElement and IsMealyMachineIntRep], 787 E->MealyMachineNC(FRMFamily(E), E!.transitions, E!.output)); 788############################################################################# 789 790############################################################################# 791## 792#M ViewObj 793## 794InstallMethod(ViewString, "(FR) displays a Mealy machine in compact form", 795 [IsMealyMachine and IsMealyMachineIntRep], 796 function(M) 797 local s; 798 s := "<Mealy machine on alphabet "; 799 APPEND@(s, AlphabetOfFRObject(M), " with ", M!.nrstates, " state"); 800 if M!.nrstates<>1 then Append(s,"s"); fi; 801 Append(s,">"); 802 return s; 803end); 804 805InstallMethod(ViewString, "(FR) displays a Mealy machine in compact form", 806 [IsMealyMachine and IsMealyMachineDomainRep], 807 M->CONCAT@("<Mealy machine on alphabet ", AlphabetOfFRObject(M), " with states ", M!.states,">")); 808 809InstallMethod(ViewString, "(FR) displays a Mealy element in compact form", 810 [IsMealyElement and IsMealyMachineIntRep], 811 function(E) 812 local s; 813 if IsOne(E) then 814 s := CONCAT@("<Trivial Mealy element on alphabet ", AlphabetOfFRObject(E), ">"); 815 else 816 s := CONCAT@("<Mealy element on alphabet ", AlphabetOfFRObject(E), 817 " with ", E!.nrstates, " state"); 818 if E!.nrstates<>1 then Append(s,"s"); fi; 819 if E!.initial<>1 then APPEND@(s,", initial state ",E!.initial); fi; 820 Append(s,">"); 821 fi; 822 return s; 823end); 824 825InstallMethod(ViewString, "(FR) displays a Mealy element in compact form", 826 [IsMealyElement and IsMealyMachineDomainRep], 827 E->CONCAT@("<Mealy element on alphabet ", AlphabetOfFRObject(E), 828 " with states ", E!.states, ", initial state ", InitialState(E), ">")); 829############################################################################# 830 831############################################################################# 832## 833#M String 834## 835InstallMethod(String, "(FR) Mealy machine to string", 836 [IsMealyMachine and IsMealyMachineIntRep], 837 M->CONCAT@("MealyMachine(",M!.transitions,", ", M!.output,")")); 838 839InstallMethod(String, "(FR) Mealy element to string", 840 [IsMealyElement and IsMealyMachineIntRep], 841 E->CONCAT@("MealyElement(",E!.transitions,", ", 842 E!.output,", ",InitialState(E),")")); 843 844InstallMethod(String, "(FR) Mealy machine to string", 845 [IsMealyMachine and IsMealyMachineDomainRep], 846 M->CONCAT@("MealyMachine(",M!.states,", ", AlphabetOfFRObject(M), 847 ", ",M!.transitions, ", ",M!.output,")")); 848 849InstallMethod(String, "(FR) Mealy element to string", 850 [IsMealyElement and IsMealyMachineDomainRep], 851 E->CONCAT@("MealyElement(",E!.states,", ", AlphabetOfFRObject(E), 852 ", ",E!.transitions,", ",E!.output,", ",InitialState(E),")")); 853############################################################################# 854 855############################################################################# 856## 857#M Display . . . . . . . . . . . . . . . . . . . .pretty-print Mealy machine 858## 859BindGlobal("MEALYDISPLAY@", function(M) 860 local a, i, j, states, slen, alen, sprint, aprint, sblank, ablank, srule, arule, s; 861 a := AlphabetOfFRObject(M); 862 states := StateSet(M); 863 if IsSubset(Integers,states) then 864 slen := LogInt(Maximum(Elements(states)),8)+2; 865 sprint := i->String(WordAlp("abcdefgh",i),slen); 866 else 867 slen := Maximum(List(states,t->Length(String(t))))+1; 868 sprint := i->String(i,slen); 869 fi; 870 sblank := ListWithIdenticalEntries(slen,' '); 871 srule := ListWithIdenticalEntries(slen,'-'); 872 if IsSubset(Integers,a) then 873 alen := LogInt(Maximum(Elements(a)),10)+3; 874 aprint := i->String(i,-alen); 875 else 876 alen := Maximum(List(a,t->Length(String(t))))+2; 877 aprint := i->String(i,-alen); 878 fi; 879 ablank := ListWithIdenticalEntries(alen,' '); 880 arule := ListWithIdenticalEntries(alen,'-'); 881 882 s := Concatenation(sblank," |"); 883 for i in a do APPEND@(s,sblank,aprint(i)," "); od; 884 APPEND@(s,"\n"); 885 APPEND@(s,srule,"-+"); for i in a do APPEND@(s,srule,arule,"+"); od; APPEND@(s,"\n"); 886 for i in states do 887 APPEND@(s,sprint(i)," |"); 888 for j in a do 889 APPEND@(s,sprint(Transition(M,i,j)),",",aprint(Output(M,i,j))); 890 od; 891 APPEND@(s,"\n"); 892 od; 893 APPEND@(s,srule,"-+"); for i in a do APPEND@(s,srule,arule,"+"); od; APPEND@(s,"\n"); 894 if IsMealyElement(M) then 895 APPEND@(s,"Initial state:",sprint(InitialState(M)),"\n"); 896 fi; 897 return s; 898end); 899 900InstallMethod(DisplayString, "(FR) for a Mealy machine", 901 [IsMealyMachine], MEALYDISPLAY@); 902 903InstallMethod(DisplayString, "(FR) for a Mealy element", 904 [IsMealyElement], MEALYDISPLAY@); 905############################################################################# 906 907############################################################################ 908## 909#M AsMealyMachine 910#M AsGroupFRMachine 911#M AsMonoidFRMachine 912#M AsSemigroupFRMachine 913#M AsMealyElement 914#M AsGroupFRElement 915#M AsMonoidFRElement 916#M AsSemigroupFRElement 917## 918BindGlobal("DOMAINTOPERMTRANS@", function(X) 919 local a, s, i, t, out, trans; 920 a := AsSortedList(AlphabetOfFRObject(X)); 921 s := AsSortedList(X!.states); 922 trans := List(s,x->List(a,y->Position(s,X!.transitions(x,y)))); 923 out := []; 924 for i in s do 925 Add(out,List(a,y->Position(a,X!.output(i,y)))); 926 od; 927 i := rec(nrstates := Length(s), transitions := trans, output := out); 928 if IsMealyElement(X) then 929 i.initial := Position(s,X!.initial); 930 i := Objectify(NewType(FREFamily([1..Length(a)]), 931 IsMealyElement and IsMealyMachineIntRep),i); 932 i := Minimized(i); 933 else 934 i := Objectify(NewType(FRMFamily([1..Length(a)]), 935 IsMealyMachine and IsMealyMachineIntRep),i); 936 fi; 937 return i; 938end); 939 940BindGlobal("MAKEMEALYMACHINE@", function(f,l,init) 941 local M, d; 942 d := List(l,DecompositionOfFRElement); 943 M := List(d,x->List(x[1],y->Position(l,y))); 944 if ForAny(M,x->fail in x) then 945 return fail; 946 elif init<>fail then 947 return MealyElementNC(f,M,List(d,x->x[2]),Position(l,init)); 948 else 949 return MealyMachineNC(f,M,List(d,x->x[2])); 950 fi; 951end); 952 953BindGlobal("ASINTREP@", function(M) 954 if IsMealyMachineIntRep(M) then 955 return M; 956 elif IsMealyMachineDomainRep(M) then 957 return DOMAINTOPERMTRANS@(M); 958 elif IsFRMachine(M) then 959 return MAKEMEALYMACHINE@(FamilyObj(M), 960 States(List(GeneratorsOfFRMachine(M),x->FRElement(M,x))),fail); 961 else 962 return MAKEMEALYMACHINE@(FamilyObj(M),States(M),M); 963 fi; 964end); 965 966InstallMethod(AsMealyMachine, "(FR) for a list of FR elements", 967 [IsFRElementCollection], 968 function(l) 969 local M, d; 970 M := MAKEMEALYMACHINE@(FamilyObj(UnderlyingFRMachine(l[1])),l,fail); 971 SetCorrespondence(M,l); 972 return M; 973end); 974 975InstallMethod(AsMealyMachine, "(FR) for a FR machine", 976 [IsFRMachine], 977 function(M) 978 local gens, states, N; 979 gens := List(GeneratorsOfFRMachine(M),x->FRElement(M,x)); 980 states := States(gens); 981 N := MAKEMEALYMACHINE@(FamilyObj(M),states,fail); 982 SetCorrespondence(N,MappingByFunction(StateSet(M),Integers,g->Position(states,g))); 983 return N; 984end); 985 986InstallMethod(AsMealyMachine, "(FR) for a Mealy machine", 987 [IsMealyMachine], 988 function(M) 989 SetCorrespondence(M,StateSet(M)); 990 return M; 991end); 992 993InstallMethod(AsMealyElement, "(FR) for a FR element", 994 [IsFRElement], 995 E->MAKEMEALYMACHINE@(FamilyObj(E),States(E),E)); 996 997InstallMethod(AsMealyElement, "(FR) for a Mealy element", 998 [IsMealyElement], E->E); 999 1000InstallMethod(AsGroupFRMachine, "(FR) for a Mealy machine", 1001 [IsMealyMachine], 1002 function(M) 1003 local G, gen, gens, realm, ntrealm, corr, i, e; 1004 M := ASINTREP@(M); 1005 if not IsInvertible(M) then return fail; fi; 1006 realm := StateSet(M); 1007 corr := []; ntrealm := []; gens := []; 1008 for i in realm do 1009 e := FRElement(M,i); 1010 if IsOne(e) then 1011 corr[i] := 0; 1012 elif IsInvertible(M) and Position(gens,Inverse(e))<>fail then 1013 corr[i] := -corr[Position(gens,Inverse(e))]; 1014 else 1015 Add(ntrealm,i); 1016 corr[i] := Length(ntrealm); 1017 fi; 1018 Add(gens,e); 1019 od; 1020 G := FreeGroup(Length(ntrealm)); 1021 gens := GeneratorsOfGroup(G); 1022 gen := function(s) if corr[s]=0 then return One(G); elif corr[s]>0 then return gens[corr[s]]; else return gens[-corr[s]]^-1; fi; end; 1023 i := FRMachineNC(FamilyObj(M),G, 1024 List(ntrealm,i->List(AlphabetOfFRObject(M),j->gen(Transition(M,i,j)))), 1025 List(ntrealm,i->Output(M,i))); 1026 SetCorrespondence(i,MappingByFunction(Domain([1..Length(corr)]),G,gen)); 1027 return i; 1028end); 1029 1030InstallMethod(AsMonoidFRMachine, "(FR) for a Mealy machine", 1031 [IsMealyMachine], 1032 function(M) 1033 local G, gen, gens, realm, ntrealm, corr, i, e; 1034 M := ASINTREP@(M); 1035 realm := StateSet(M); 1036 corr := []; ntrealm := []; gens := []; 1037 for i in realm do 1038 e := FRElement(M,i); 1039 if IsOne(e) then 1040 corr[i] := 0; 1041 else 1042 Add(ntrealm,i); 1043 corr[i] := Length(ntrealm); 1044 fi; 1045 Add(gens,e); 1046 od; 1047 G := FreeMonoid(Length(ntrealm)); 1048 gens := GeneratorsOfMonoid(G); 1049 gen := function(s) if corr[s]=0 then return One(G); else return gens[corr[s]]; fi; end; 1050 i := FRMachineNC(FamilyObj(M),G, 1051 List(ntrealm,i->List(AlphabetOfFRObject(M),j->gen(Transition(M,i,j)))), 1052 List(ntrealm,i->Output(M,i))); 1053 SetCorrespondence(i,MappingByFunction(Domain([1..Length(corr)]),G,gen)); 1054 return i; 1055end); 1056 1057InstallMethod(AsSemigroupFRMachine, "(FR) for a Mealy machine", 1058 [IsMealyMachine], 1059 function(M) 1060 local G, gen, gens, realm, ntrealm, corr, i, e; 1061 M := ASINTREP@(M); 1062 realm := StateSet(M); 1063 corr := []; ntrealm := []; gens := []; 1064 for i in realm do 1065 e := FRElement(M,i); 1066 Add(ntrealm,i); 1067 corr[i] := Length(ntrealm); 1068 Add(gens,e); 1069 od; 1070 G := FreeSemigroup(Length(ntrealm)); 1071 gens := GeneratorsOfSemigroup(G); 1072 gen := function(s) return gens[corr[s]]; end; 1073 i := FRMachineNC(FamilyObj(M),G, 1074 List(ntrealm,i->List(AlphabetOfFRObject(M),j->gen(Transition(M,i,j)))), 1075 List(ntrealm,i->Output(M,i))); 1076 SetCorrespondence(i,MappingByFunction(Domain([1..Length(corr)]),G,gen)); 1077 return i; 1078end); 1079 1080InstallMethod(AsGroupFRElement, "(FR) for a Mealy element", 1081 [IsMealyElement], 1082 function(E) 1083 local m; 1084 m := AsGroupFRMachine(UnderlyingFRMachine(E)); 1085 return FRElement(m,InitialState(E)^Correspondence(m)); 1086end); 1087 1088InstallMethod(AsMonoidFRElement, "(FR) for a Mealy element", 1089 [IsMealyElement], 1090 function(E) 1091 local m; 1092 m := AsMonoidFRMachine(UnderlyingFRMachine(E)); 1093 return FRElement(m,InitialState(E)^Correspondence(m)); 1094end); 1095 1096InstallMethod(AsSemigroupFRElement, "(FR) for a Mealy element", 1097 [IsMealyElement], 1098 function(E) 1099 local m; 1100 m := AsSemigroupFRMachine(UnderlyingFRMachine(E)); 1101 return FRElement(m,InitialState(E)^Correspondence(m)); 1102end); 1103 1104InstallMethod(AsIntMealyMachine, "(FR) for a Mealy machine", 1105 [IsMealyMachine and IsMealyMachineIntRep], AsMealyMachine); 1106InstallMethod(AsIntMealyMachine, "(FR) for a Mealy machine", 1107 [IsMealyMachine], DOMAINTOPERMTRANS@); 1108 1109InstallMethod(AsIntMealyElement, "(FR) for a Mealy machine", 1110 [IsMealyElement and IsMealyMachineIntRep], AsMealyElement); 1111InstallMethod(AsIntMealyElement, "(FR) for a Mealy machine", 1112 [IsMealyElement], DOMAINTOPERMTRANS@); 1113 1114BindGlobal("TOPELEMENTPERM@", function(l) 1115 local n; 1116 n := Length(l); 1117 if l=[1..n] then 1118 return MealyElementNC(FREFamily([1..n]), 1119 [ListWithIdenticalEntries(n,1)],[[1..n]],1); 1120 fi; 1121 return MealyElementNC(FREFamily([1..n]), 1122 List([1..2],i->ListWithIdenticalEntries(n,2)), 1123 [l,[1..n]],1); 1124end); 1125InstallMethod(TopElement, "(FR) for a permutation", 1126 [IsPerm], 1127 p->TOPELEMENTPERM@(ListPerm(p))); 1128InstallMethod(TopElement, "(FR) for a permutation and a degree", 1129 [IsPerm,IsInt], 1130 function(p,n) 1131 return TOPELEMENTPERM@(ListPerm(p,n)); 1132end); 1133InstallMethod(TopElement, "(FR) for a transformation", 1134 [IsTransformation], 1135 t->TOPELEMENTPERM@(ListTransformation(t))); 1136InstallMethod(TopElement, "(FR) for a transformation and a degree", 1137 [IsTransformation,IsInt], 1138 function(t,n) 1139 return TOPELEMENTPERM@(ListTransformation(t,n)); 1140end); 1141############################################################################# 1142 1143############################################################################# 1144## 1145#M Draw . . . . . . . . . . . . . . . . . .draw Mealy machine using graphviz 1146## 1147BindGlobal("MM2DOT@", function(M) 1148 local names, i, j, S, stateset, alphabet; 1149 1150 S := "digraph "; 1151 if HasName(M) and ForAll(Name(M),IsAlphaChar) then 1152 Append(S, "\""); Append(S, Name(M)); Append(S, "\""); 1153 else 1154 Append(S,"MealyMachine"); 1155 fi; 1156 Append(S," {\n"); 1157 if IsMealyMachineIntRep(M) then 1158 stateset := [1..M!.nrstates]; 1159 else 1160 stateset := AsSortedList(M!.states); 1161 fi; 1162 alphabet := AsSortedList(AlphabetOfFRObject(M)); 1163 if IsSubset(Integers, alphabet) and IsSubset(Integers, stateset) then 1164 names := List([1..Length(stateset)], i->WordAlp("abcdefgh", i)); 1165 else 1166 names := List(stateset, String); 1167 fi; 1168 1169 for i in [1..Length(names)] do 1170 Append(S, names[i]); 1171 Append(S," [shape="); 1172 if IsBound(M!.initial) and M!.initial = stateset[i] then 1173 Append(S,"double"); 1174 fi; 1175 Append(S,"circle]\n"); 1176 od; 1177 for i in [1..Length(names)] do 1178 for j in alphabet do 1179 Append(S," "); 1180 Append(S,names[i]); 1181 Append(S," -> "); 1182 Append(S,names[Position(stateset,Transition(M,stateset[i],j))]); 1183 Append(S," [label=\""); 1184 Append(S,String(j)); 1185 Append(S,"/"); 1186 Append(S,String(Output(M,stateset[i],j))); 1187 Append(S,"\",color="); 1188 Append(S,COLOURS@(Position(alphabet,j))); 1189 Append(S,"];\n"); 1190 od; 1191 od; 1192 Append(S,"}\n"); 1193 return S; 1194end); 1195 1196BindGlobal("DRAWMEALY@", function(M) 1197 DOT2DISPLAY@(MM2DOT@(M),"dot"); 1198end); 1199 1200InstallMethod(Draw, "(FR) draws a Mealy machine using graphviz", 1201 [IsMealyMachine], 1202 DRAWMEALY@); 1203 1204InstallMethod(Draw, "(FR) draws a Mealy machine using graphviz", 1205 [IsMealyMachine, IsString], 1206 function(M,str) 1207 AppendTo(str,MM2DOT@(M)); 1208end); 1209 1210InstallMethod(Draw, "(FR) draws a Mealy element using graphviz", 1211 [IsMealyElement], 1212 DRAWMEALY@); 1213 1214InstallMethod(Draw, "(FR) draws a Mealy element using graphviz", 1215 [IsMealyElement, IsString], 1216 function(M,str) 1217 AppendTo(str,MM2DOT@(M)); 1218end); 1219 1220BindGlobal("INSTALLMMHANDLER@", function(name,rv) 1221 InstallOtherMethod(name, "(FR) for a generic Mealy machine", 1222 [IsFRMachine], 1223 function(M) 1224 Info(InfoFR, 2, name, ": converting to Mealy machine"); 1225 if rv then 1226 return name(ASINTREP@(M)); 1227 else 1228 name(ASINTREP@(M)); 1229 fi; 1230 end); 1231end); 1232BindGlobal("INSTALLMEHANDLER@", function(name,rv) 1233 InstallOtherMethod(name, "(FR) for a generic Mealy element", 1234 [IsFRElement], 1235 function(E) 1236 Info(InfoFR, 2, name, ": converting to Mealy element"); 1237 if rv then 1238 return name(ASINTREP@(E)); 1239 else 1240 name(ASINTREP@(E)); 1241 fi; 1242 end); 1243end); 1244 1245INSTALLMEHANDLER@(Draw,false); 1246INSTALLMMHANDLER@(Draw,false); 1247 1248InstallOtherMethod(Draw, "(FR) for a FR machine and a filename", 1249 [IsFRMachine,IsString], 1250 function(M,S) 1251 Info(InfoFR, 1, "Draw: converting to Mealy machine"); 1252 Draw(ASINTREP@(M),S); 1253end); 1254 1255InstallOtherMethod(Draw, "(FR) for a FR element and a filename", 1256 [IsFRElement,IsString], 1257 function(E,S) 1258 Info(InfoFR, 1, "Draw: converting to Mealy element"); 1259 Draw(ASINTREP@(E),S); 1260end); 1261############################################################################ 1262 1263############################################################################ 1264## 1265#M Methods for the comparison operations for Mealy machines 1266## 1267InstallMethod(IsOne, "(FR) for a Mealy element", 1268 [IsMealyElement and IsMealyMachineIntRep], 1269 function(E) 1270 return E!.output = [AlphabetOfFRObject(E)]; 1271end); 1272INSTALLMEHANDLER@(IsOne,true); 1273 1274InstallMethod(\=, "(FR) for two Mealy elements", IsIdenticalObj, 1275 [IsMealyElement and IsMealyMachineIntRep, IsMealyElement and IsMealyMachineIntRep], 1276 function(x,y) 1277 return x!.output = y!.output and x!.transitions = y!.transitions; 1278end); 1279 1280InstallMethod(\<, "(FR) for two Mealy elements", IsIdenticalObj, 1281 [IsMealyElement and IsMealyMachineIntRep, IsMealyElement and IsMealyMachineIntRep], 1282 function(x,y) 1283 local z, ix, iy, i, j, todo; 1284 1285 if x=y then return false; fi; 1286 1287 z := UnderlyingFRMachine(x)+UnderlyingFRMachine(y); 1288 ix := InitialState(x)^Correspondence(z)[1]; 1289 iy := InitialState(y)^Correspondence(z)[2]; 1290 z := Minimized(z); 1291 ix := ix^Correspondence(z); 1292 iy := iy^Correspondence(z); 1293 todo := NewFIFO([[ix,iy]]); 1294 for i in todo do 1295 if Output(z,i[1])<>Output(z,i[2]) then 1296 return Output(z,i[1])<Output(z,i[2]); 1297 fi; 1298 for j in AlphabetOfFRObject(z) do 1299 ix := Transition(z,i[1],j); 1300 iy := Transition(z,i[2],j); 1301 if ix<>iy then 1302 Add(todo,[ix,iy]); 1303 fi; 1304 od; 1305 od; 1306end); 1307 1308InstallMethod(IsOne, "(FR) for a Mealy machine", 1309 [IsMealyMachine], 1310 function(x) 1311 local ix; 1312 if IsFinite(AlphabetOfFRObject(x)) then 1313 ix := ASINTREP@(x); 1314 return ix!.output=[AlphabetOfFRObject(x)]; 1315 else 1316 TryNextMethod(); 1317 fi; 1318end); 1319 1320InstallMethod(\=, "(FR) for two Mealy machines in int rep", IsIdenticalObj, 1321 [IsMealyMachine and IsMealyMachineIntRep, IsMealyMachine and IsMealyMachineIntRep], 1322 function(x,y) 1323 return x!.nrstates = y!.nrstates and 1324 x!.transitions = y!.transitions and 1325 x!.output = y!.output; 1326end); 1327 1328InstallMethod(\=, "(FR) for two Mealy machines in domain rep", IsIdenticalObj, 1329 [IsMealyMachine and IsMealyMachineDomainRep, IsMealyMachine and IsMealyMachineDomainRep], 1330 function(x,y) 1331 if IsFinite(AlphabetOfFRObject(x)) then 1332 return ASINTREP@(x)=ASINTREP@(y); 1333 else 1334 return x!.nrstates = y!.nrstates and 1335 x!.transitions = y!.transitions and 1336 x!.output = y!.output; 1337 fi; 1338end); 1339 1340InstallMethod(\=, "(FR) for two Mealy elements", IsIdenticalObj, 1341 [IsMealyElement, IsMealyElement], 1342 function(x,y) 1343 if not IsFinite(AlphabetOfFRObject(x)) then 1344 Error("Don't know how to compare machines in domain representation"); 1345 fi; 1346 if IsMealyMachineDomainRep(x) then 1347 x := ASINTREP@(x); 1348 fi; 1349 if IsMealyMachineDomainRep(y) then 1350 y := ASINTREP@(y); 1351 fi; 1352 return x=y; 1353end); 1354 1355InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj, 1356 [IsMealyMachine and IsMealyMachineIntRep, IsMealyMachine and IsMealyMachineDomainRep], 1357 ReturnTrue); 1358 1359InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj, 1360 [IsMealyMachine and IsMealyMachineDomainRep, IsMealyMachine and IsMealyMachineIntRep], 1361 ReturnFalse); 1362 1363BindGlobal("MMLTINTREP@", function(x,y) 1364 local a, s; 1365 if x!.nrstates <> y!.nrstates then 1366 return x!.nrstates < y!.nrstates; 1367 elif x!.transitions <> y!.transitions then 1368 return x!.transitions < y!.transitions; 1369 else 1370 return x!.output < y!.output; 1371 fi; 1372end); 1373 1374InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj, 1375 [IsMealyMachine and IsMealyMachineIntRep, IsMealyMachine and IsMealyMachineIntRep], 1376 MMLTINTREP@); 1377 1378InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj, 1379 [IsMealyMachine and IsMealyMachineDomainRep, IsMealyMachine and IsMealyMachineDomainRep], 1380 function(x,y) 1381 if IsFinite(AlphabetOfFRObject(x)) then 1382 return MMLTINTREP@(ASINTREP@(x), ASINTREP@(y)); 1383 else 1384 if x!.nrstates <> y!.nrstates then 1385 return x!.nrstates < y!.nrstates; 1386 elif x!.transitions <> y!.transitions then 1387 return x!.transitions < y!.transitions; 1388 elif x!.output <> y!.output then 1389 return x!.output < y!.output; 1390 fi; 1391 return false; # they're equal 1392 fi; 1393end); 1394 1395InstallMethod(\<, "(FR) for two Mealy elements", IsIdenticalObj, 1396 [IsMealyElement, IsMealyElement], 1397 function(x,y) 1398 if not IsFinite(AlphabetOfFRObject(x)) then 1399 Error("Don't know how to compare machines in domain representation"); 1400 fi; 1401 if IsMealyMachineDomainRep(x) then 1402 x := ASINTREP@(x); 1403 fi; 1404 if IsMealyMachineDomainRep(y) then 1405 y := ASINTREP@(y); 1406 fi; 1407 return x<y; 1408end); 1409############################################################################ 1410 1411############################################################################ 1412## 1413#M Products of Mealy machines 1414## 1415############################################################################ 1416InstallMethod(\+, "(FR) for two Mealy machines", IsIdenticalObj, 1417 [IsMealyMachine and IsMealyMachineDomainRep, 1418 IsMealyMachine and IsMealyMachineDomainRep], function(arg) 1419 local q, a, trans, out; 1420 q := Domain(Cartesian([1..Length(arg)],Union(List(arg,M->M!.states)))); 1421 trans := function(s,a) 1422 return [s[1],arg[s[1]]!.transitions(s[2],a)]; 1423 end; 1424 out := function(s,a) 1425 return arg[s[1]]!.output(s[2],a); 1426 end; 1427 a := MealyMachine(q,AlphabetOfFRObject(arg[1]),trans,out); 1428 if ForAll(arg,HasIsInvertible) then 1429 SetIsInvertible(a,ForAll(arg,IsInvertible)); 1430 fi; 1431 SetCorrespondence(a,i->MappingByFunction(arg[i]!.states,q,s->[i,s])); 1432 SET_NAME@(arg,"+",a); 1433 return a; 1434end); 1435 1436InstallMethod(\+, "(FR) for two Mealy machines", IsIdenticalObj, 1437 [IsMealyMachine and IsMealyMachineIntRep, 1438 IsMealyMachine and IsMealyMachineIntRep], 1439 function(M,N) 1440 local a; 1441 a := MealyMachineNC(FamilyObj(M), 1442 Concatenation(M!.transitions,N!.transitions+M!.nrstates), 1443 Concatenation(M!.output,N!.output)); 1444 if HasIsInvertible(M) and HasIsInvertible(N) then 1445 SetIsInvertible(a,IsInvertible(M) and IsInvertible(N)); 1446 fi; 1447 SetCorrespondence(a,[IdentityTransformation,TransformationListList([1..N!.nrstates],M!.nrstates+[1..N!.nrstates])]); 1448 SET_NAME@([M,N],"+",a); 1449 return a; 1450end); 1451 1452InstallMethod(\+, "(FR) for generic FR machines", IsIdenticalObj, 1453 [IsFRMachine,IsFRMachine], 1454 function(x,y) 1455 return ASINTREP@(x)+ASINTREP@(y); 1456end); 1457 1458InstallMethod(\*, "(FR) for two Mealy machines", IsIdenticalObj, 1459 [IsMealyMachine and IsMealyMachineDomainRep, 1460 IsMealyMachine and IsMealyMachineDomainRep], 1461 function(M,N) 1462 local q, a, trans, out; 1463 q := Domain(Cartesian(M!.states,N!.states)); 1464 trans := function(s,a) 1465 return [M!.transition(s[1],a),N!.transition(s[2],M!.output(s[1],a))]; 1466 end; 1467 out := function(s,a) 1468 return N!.output(s[2],M!.output(s[1],a)); 1469 end; 1470 a := MealyMachine(q,AlphabetOfFRObject(M),trans,out); 1471 if HasIsInvertible(M) and HasIsInvertible(N) then 1472 SetIsInvertible(a,IsInvertible(M) and IsInvertible(N)); 1473 fi; 1474 SET_NAME@([M,N],"*",a); 1475 return a; 1476end); 1477 1478InstallMethod(\*, "(FR) for two Mealy machines", IsIdenticalObj, 1479 [IsMealyMachine and IsMealyMachineIntRep, 1480 IsMealyMachine and IsMealyMachineIntRep], 1481 function(M,N) 1482 local trans, out, i, j, a, t, o; 1483 1484 trans := []; 1485 out := []; 1486 for i in [1..M!.nrstates] do 1487 o := M!.output[i]; 1488 t := (M!.transitions[i]-1)*N!.nrstates; 1489 for j in [1..N!.nrstates] do 1490 Add(trans,t+N!.transitions[j]{o}); 1491 Add(out,N!.output[j]{o}); 1492 od; 1493 od; 1494 a := MealyMachineNC(FamilyObj(M),trans,out); 1495 if HasIsInvertible(M) and HasIsInvertible(N) then 1496 SetIsInvertible(a,IsInvertible(M) and IsInvertible(N)); 1497 fi; 1498 SET_NAME@([M,N],"*",a); 1499 return a; 1500end); 1501 1502InstallMethod(\*, "(FR) for generic FR machines", IsIdenticalObj, 1503 [IsFRMachine,IsFRMachine], 1504 function(x,y) 1505 return ASINTREP@(x)*ASINTREP@(y); 1506end); 1507 1508InstallMethod(TensorProductOp, "(FR) for Mealy machines", 1509 [IsList,IsMealyMachine and IsMealyMachineDomainRep], 1510 function(M,N) 1511 local a, d, trans, out; 1512 while ForAny(M,x->x!.states<>N!.states) do 1513 Error("All machines should have same stateset"); 1514 od; 1515 d := Length(M); 1516 a := Domain(Cartesian(List(M,AlphabetOfFRObject))); 1517 trans := function(s,a) 1518 local i; 1519 for i in [1..d] do s := M[i]!.transitions(s,a[i]); od; 1520 return s; 1521 end; 1522 out := function(s,a) 1523 local i, b; 1524 b := []; 1525 for i in [1..d] do 1526 Add(b,M[i]!.output(s,a[i])); 1527 s := M[i]!.transitions(s,a[i]); 1528 od; 1529 return b; 1530 end; 1531 a := MealyMachine(N!.states,a,trans,out); 1532 if ForAll(M,HasIsInvertible) then 1533 SetIsInvertible(a,ForAll(M,IsInvertible)); 1534 fi; 1535 SET_NAME@(M,"(*)",a); 1536 return a; 1537end); 1538 1539InstallMethod(TensorProductOp, "(FR) for two integer Mealy machines", 1540 [IsList,IsMealyMachine and IsMealyMachineIntRep], 1541 function(M,N) 1542 local a, b, trans, out, t, o, d, i, j, alphabet, s; 1543 1544 while ForAny(M,x->x!.nrstates<>N!.nrstates) do 1545 Error("All machines should have same stateset"); 1546 od; 1547 1548 alphabet := Cartesian(List(M,AlphabetOfFRObject)); 1549 1550 trans := []; 1551 out := []; 1552 for i in [1..N!.nrstates] do 1553 t := []; 1554 o := []; 1555 for a in alphabet do 1556 b := []; 1557 s := i; 1558 for j in [1..Length(M)] do 1559 Add(b,M[j]!.output[s][a[j]]); 1560 s := M[j]!.transitions[s][a[j]]; 1561 od; 1562 Add(o,Position(alphabet,b)); 1563 Add(t,s); 1564 od; 1565 Add(trans,t); 1566 Add(out,o); 1567 od; 1568 a := MealyMachineNC(FRMFamily([1..Size(alphabet)]),trans,out); 1569 if ForAll(M,HasIsInvertible) then 1570 SetIsInvertible(a,ForAll(M,IsInvertible)); 1571 fi; 1572 SET_NAME@(M,"(*)",a); 1573 return a; 1574end); 1575 1576InstallMethod(TensorProductOp, "(FR) for generic FR machines", 1577 [IsList,IsFRMachine], 1578 function(M,N) 1579 M := List(M,ASINTREP@); 1580 return TensorProductOp(M,M[1]); 1581end); 1582 1583InstallMethod(TensorSumOp, "(FR) for two Mealy machines", 1584 [IsList,IsMealyMachine and IsMealyMachineDomainRep], 1585 function(M,N) 1586 local a, d, trans, out; 1587 1588 while ForAny(M,x->x!.states<>N!.states) do 1589 Error("All machines should have same stateset"); 1590 od; 1591 d := Length(M); 1592 a := Domain(Union(List([1..d],i->Cartesian(AlphabetOfFRObject(M[i]),[i])))); 1593 trans := function(s,a) 1594 return M[a[2]]!.transitions(s,a[1]); 1595 end; 1596 out := function(s,a) 1597 return [M[a[2]]!.output(s,a[1]),a[2]]; 1598 end; 1599 a := MealyMachine(N!.states,a,trans,out); 1600 if ForAll(M,HasIsInvertible) then 1601 SetIsInvertible(a,ForAll(M,IsInvertible)); 1602 fi; 1603 SET_NAME@(M,"(+)",a); 1604 return a; 1605end); 1606 1607InstallMethod(TensorSumOp, "(FR) for two integer Mealy machines", 1608 [IsList,IsMealyMachine and IsMealyMachineIntRep], 1609 function(M,N) 1610 local trans, out, t, o, a, d, i, j; 1611 1612 while ForAny(M,x->x!.nrstates<>N!.nrstates) do 1613 Error("All machines should have same stateset"); 1614 od; 1615 1616 trans := []; 1617 out := []; 1618 for i in [1..N!.nrstates] do 1619 t := []; 1620 o := []; 1621 d := 0; 1622 for j in [1..Length(M)] do 1623 Append(t,M[j]!.transitions[i]); 1624 Append(o,M[j]!.output[i]+d); 1625 d := d+Size(AlphabetOfFRObject(M[j])); 1626 od; 1627 Add(trans,t); 1628 Add(out,o); 1629 od; 1630 a := MealyMachineNC(FRMFamily([1..d]),trans,out); 1631 if ForAll(M,HasIsInvertible) then 1632 SetIsInvertible(a,ForAll(M,IsInvertible)); 1633 fi; 1634 SET_NAME@(M,"(+)",a); 1635 return a; 1636end); 1637 1638InstallMethod(TensorSumOp, "(FR) for generic FR machines", 1639 [IsList,IsFRMachine], 1640 function(M,N) 1641 M := List(M,ASINTREP@); 1642 return TensorSumOp(M,M[1]); 1643end); 1644 1645InstallMethod(DirectSumOp, "(FR) for two Mealy machines", 1646 [IsList,IsMealyMachine and IsMealyMachineDomainRep], 1647 function(M,N) 1648 local a, s, d, trans, out; 1649 1650 d := Length(M); 1651 a := Domain(Union(List([1..d],i->Cartesian(AlphabetOfFRObject(M[i]),[i])))); 1652 s := Domain(Union(List([1..d],i->Cartesian(M[i]!.states,[i])))); 1653 trans := function(s,a) 1654 if s[2]=a[2] then 1655 return [M[s[2]]!.transitions(s[1],a[1]),s[2]]; 1656 else 1657 return s; 1658 fi; 1659 end; 1660 out := function(s,a) 1661 if s[2]=a[2] then 1662 return [M[s[2]]!.output(s[1],a[1]),s[2]]; 1663 else 1664 return a; 1665 fi; 1666 end; 1667 a := MealyMachine(s,a,trans,out); 1668 if ForAll(M,HasIsInvertible) then 1669 SetIsInvertible(a,ForAll(M,IsInvertible)); 1670 fi; 1671 SET_NAME@(M,"(+)",a); 1672 return a; 1673end); 1674 1675InstallMethod(DirectSumOp, "(FR) for two integer Mealy machines", 1676 [IsList,IsMealyMachine and IsMealyMachineIntRep], 1677 function(M,N) 1678 local trans, out, t, o, a, d, i, j, ashift, sshift, alphabet; 1679 1680 d := 0; 1681 ashift := []; 1682 alphabet := []; 1683 for i in [1..Length(M)] do 1684 j := Length(AlphabetOfFRObject(M[i])); 1685 Add(ashift,[d+1..d+j]); 1686 d := d + j; 1687 od; 1688 1689 trans := []; 1690 out := []; 1691 for i in [1..Length(M)] do 1692 sshift := Length(trans); 1693 for j in [1..M[i]!.nrstates] do 1694 t := ListWithIdenticalEntries(d,sshift+j); 1695 t{ashift[i]} := sshift+M[i]!.transitions[j]; 1696 o := [1..d]; 1697 o{ashift[i]} := ashift[i]{M[i]!.output[j]}; 1698 Add(trans,t); 1699 Add(out,o); 1700 od; 1701 od; 1702 a := MealyMachineNC(FRMFamily([1..d]),trans,out); 1703 if ForAll(M,HasIsInvertible) then 1704 SetIsInvertible(a,ForAll(M,IsInvertible)); 1705 fi; 1706 SET_NAME@(M,"#",a); 1707 return a; 1708end); 1709 1710InstallMethod(DirectSumOp, "(FR) for generic FR machines", 1711 [IsList,IsFRMachine], 1712 function(M,N) 1713 M := List(M,ASINTREP@); 1714 return DirectSumOp(M,M[1]); 1715end); 1716 1717InstallMethod(DirectProductOp, "(FR) for two Mealy machines", 1718 [IsList,IsMealyMachine and IsMealyMachineDomainRep], 1719 function(M,N) 1720 local a, s, d, trans, out; 1721 1722 d := Length(M); 1723 a := Domain(Cartesian(List(M,AlphabetOfFRObject))); 1724 s := Domain(Cartesian(List(M,StateSet))); 1725 trans := function(s,a) 1726 return List([1..d],i->M[i]!.transitions(s[i],a[i])); 1727 end; 1728 out := function(s,a) 1729 return List([1..d],i->M[i]!.output(s[i],a[i])); 1730 end; 1731 a := MealyMachine(s,a,trans,out); 1732 if ForAll(M,HasIsInvertible) then 1733 SetIsInvertible(a,ForAll(M,IsInvertible)); 1734 fi; 1735 SET_NAME@(M,"@",a); 1736 return a; 1737end); 1738 1739InstallMethod(DirectProductOp, "(FR) for two integer Mealy machines", 1740 [IsList,IsMealyMachine and IsMealyMachineIntRep], 1741 function(M,N) 1742 local states, alphabet, trans, out, t, o, i, j, a, b, s; 1743 1744 states := Cartesian(List(M,StateSet)); 1745 alphabet := Cartesian(List(M,AlphabetOfFRObject)); 1746 1747 trans := []; 1748 out := []; 1749 for i in states do 1750 t := []; 1751 o := []; 1752 for a in alphabet do 1753 s := []; 1754 b := []; 1755 for j in [1..Length(i)] do 1756 Add(s,M[j]!.transitions[i[j]][a[j]]); 1757 Add(b,M[j]!.output[i[j]][a[j]]); 1758 od; 1759 Add(t,Position(states,s)); 1760 Add(o,Position(alphabet,b)); 1761 od; 1762 Add(trans,t); 1763 Add(out,o); 1764 od; 1765 a := MealyMachineNC(FRMFamily([1..Length(alphabet)]),trans,out); 1766 if ForAll(M,HasIsInvertible) then 1767 SetIsInvertible(a,ForAll(M,IsInvertible)); 1768 fi; 1769 SET_NAME@(M,"@",a); 1770 return a; 1771end); 1772 1773InstallMethod(DirectProductOp, "(FR) for generic FR machines", 1774 [IsList,IsFRMachine], 1775 function(M,N) 1776 M := List(M,ASINTREP@); 1777 return DirectProductOp(M,M[1]); 1778end); 1779 1780InstallMethod(TreeWreathProduct, "(FR) for two domain Mealy machines", 1781 [IsMealyMachine and IsMealyMachineDomainRep, 1782 IsMealyMachine and IsMealyMachineDomainRep, IsObject, IsObject], 1783 function(g,h,x0,y0) 1784 local alphabet, states, trans, out, m; 1785 1786 alphabet := Domain(Cartesian(AlphabetOfFRObject(g),AlphabetOfFRObject(h))); 1787 while not [x0,y0] in alphabet do 1788 Error("(x0,y0) must be in the product of the machines' alphabets"); 1789 od; 1790 states := Domain(Union(Cartesian(StateSet(g),[1,3]),Cartesian(StateSet(h),[2]),[true])); 1791 1792 trans := function(s,a) 1793 if s[2]=1 and a=[x0,y0] then 1794 return s; 1795 elif s[2]=1 and a[2]=y0 then 1796 return [s[1],3]; 1797 elif s[2]=2 and a[1]=x0 then 1798 return [Transition(h,s[1],a[2]),2]; 1799 elif s[2]=3 and a[2]=y0 then 1800 return [Transition(g,s[1],a[1]),3]; 1801 else 1802 return true; 1803 fi; 1804 end; 1805 out := function(s,a) 1806 if s[2]=2 then 1807 return [a[1],Output(h,s[1],a[2])]; 1808 elif s[2]=3 and a[2]=y0 then 1809 return [Output(g,s[1],a[1]),a[2]]; 1810 else 1811 return a; 1812 fi; 1813 end; 1814 m := MealyMachine(states,alphabet,trans,out); 1815 if HasIsInvertible(g) and HasIsInvertible(h) then 1816 SetIsInvertible(m,IsInvertible(g) and IsInvertible(h)); 1817 fi; 1818 SET_NAME@([g,h],"~",m); 1819 return m; 1820end); 1821 1822InstallMethod(TreeWreathProduct, "(FR) for two integer Mealy machines", 1823 [IsMealyMachine and IsMealyMachineIntRep, 1824 IsMealyMachine and IsMealyMachineIntRep, IsPosInt, IsPosInt], 1825 function(g,h,x0,y0) 1826 local alphabet, one, trans, out, t, o, i, j, m; 1827 1828 alphabet := Cartesian(AlphabetOfFRObject(g),AlphabetOfFRObject(h)); 1829 while not [x0,y0] in alphabet do 1830 Error("(x0,y0) must be in the product of the machines' alphabets"); 1831 od; 1832 one := 2*g!.nrstates+h!.nrstates+1; 1833 1834 trans := []; 1835 out := []; 1836 for i in [1..g!.nrstates] do 1837 t := []; 1838 o := []; 1839 for j in alphabet do 1840 if j=[x0,y0] then 1841 Add(t,i); 1842 elif j[2]=y0 then 1843 Add(t,i+g!.nrstates+h!.nrstates); 1844 else 1845 Add(t,one); 1846 fi; 1847 Add(o,Position(alphabet,j)); 1848 od; 1849 Add(trans,t); 1850 Add(out,o); 1851 od; 1852 for i in [1..h!.nrstates] do 1853 t := []; 1854 o := []; 1855 for j in alphabet do 1856 if j[1]=x0 then 1857 Add(t,Transition(h,i,j[2])+g!.nrstates); 1858 else 1859 Add(t,one); 1860 fi; 1861 Add(o,Position(alphabet,[j[1],Output(h,i,j[2])])); 1862 od; 1863 Add(trans,t); 1864 Add(out,o); 1865 od; 1866 for i in [1..g!.nrstates] do 1867 t := []; 1868 o := []; 1869 for j in alphabet do 1870 if j[2]=y0 then 1871 Add(t,Transition(g,i,j[1])+g!.nrstates+h!.nrstates); 1872 Add(o,Position(alphabet,[Output(g,i,j[1]),y0])); 1873 else 1874 Add(t,one); 1875 Add(o,Position(alphabet,j)); 1876 fi; 1877 od; 1878 Add(trans,t); 1879 Add(out,o); 1880 od; 1881 Add(trans,ListWithIdenticalEntries(Length(alphabet),one)); 1882 Add(out,[1..Length(alphabet)]); 1883 1884 m := Minimized(MealyMachineNC(FRMFamily([1..Length(alphabet)]),trans,out)); 1885 m!.Correspondence := [TransformationListList([1..g!.nrstates],List([1..g!.nrstates],i->i^Correspondence(m))), 1886 TransformationListList([1..h!.nrstates]+g!.nrstates,List([1..h!.nrstates],i->i^Correspondence(m)))]; 1887 if HasIsInvertible(g) and HasIsInvertible(h) then 1888 SetIsInvertible(m,IsInvertible(g) and IsInvertible(h)); 1889 fi; 1890 SET_NAME@([g,h],"~",m); 1891 return m; 1892end); 1893 1894InstallMethod(TreeWreathProduct, "for two generic FR machines", 1895 [IsFRMachine, IsFRMachine, IsObject, IsObject], 1896 function(g,h,x0,y0) 1897 return TreeWreathProduct(ASINTREP@(g),ASINTREP@(h),x0,y0); 1898 # !!! probably x0, y0 should be changed to their int counterparts? 1899end); 1900############################################################################ 1901 1902############################################################################ 1903## 1904#M Products of Mealy elements 1905## 1906InstallMethod(\*, "(FR) for two Mealy elements", IsIdenticalObj, 1907 [IsMealyElement and IsMealyMachineDomainRep, 1908 IsMealyElement and IsMealyMachineDomainRep], 1909 function(M,N) 1910 local q, a, trans, out; 1911 q := Domain(Cartesian(M!.states,N!.states)); 1912 trans := function(s,a) 1913 return [M!.transition(s[1],a),N!.transition(s[2],M!.output(s[1],a))]; 1914 end; 1915 out := function(s,a) 1916 return N!.output(s[2],M!.output(s[1],a)); 1917 end; 1918 a := MealyElement(q,AlphabetOfFRObject(M),trans,out,[M!.initial,N!.initial]); 1919 if HasIsInvertible(M) and HasIsInvertible(N) then 1920 SetIsInvertible(a,IsInvertible(M) and IsInvertible(N)); 1921 fi; 1922 SET_NAME@([M,N],"*",a); 1923 return a; 1924end); 1925 1926InstallMethod(\*, "(FR) for two Mealy elements", IsIdenticalObj, 1927 [IsMealyElement and IsMealyMachineIntRep, 1928 IsMealyElement and IsMealyMachineIntRep], 1929 function(M,N) 1930 local sdict, todo, a, i, x, t, tr, trans, out; 1931 1932 if IsOne(M) then return N; elif IsOne(N) then return M; fi; 1933 1934 sdict := NewDictionary([1,1],true); 1935 todo := [[M!.initial,N!.initial]]; 1936 AddDictionary(sdict,[M!.initial,N!.initial],1); 1937 1938 trans := []; 1939 out := []; 1940 for i in todo do 1941 tr := []; 1942 for a in AlphabetOfFRObject(M) do 1943 t := [M!.transitions[i[1]][a],N!.transitions[i[2]][M!.output[i[1]][a]]]; 1944 x := LookupDictionary(sdict,t); 1945 if x=fail then 1946 Add(todo,t); 1947 x := Length(todo); 1948 AddDictionary(sdict,t,x); 1949 fi; 1950 Add(tr,x); 1951 od; 1952 Add(trans,tr); 1953 Add(out,N!.output[i[2]]{M!.output[i[1]]}); 1954 od; 1955 a := MMMINIMIZE@(FamilyObj(M),AlphabetOfFRObject(M), 1956 Length(trans),trans,out,1,1); 1957 if HasIsInvertible(M) and HasIsInvertible(N) then 1958 SetIsInvertible(a,IsInvertible(M) and IsInvertible(N)); 1959 fi; 1960 return a; 1961end); 1962 1963InstallMethod(\*, "(FR) for an FR element and a Mealy element", 1964 [IsFRElement, IsMealyElement], 1965 function(M,N) 1966 Info(InfoFR, 1, "\\*: converting second argument to FR element"); 1967 return M*AsSemigroupFRElement(N); 1968end); 1969 1970InstallMethod(\*, "(FR) for a Mealy element and an FR element", 1971 [IsMealyElement, IsFRElement], 1972 function(M,N) 1973 Info(InfoFR, 1, "\\*: converting first argument to FR element"); 1974 return AsSemigroupFRElement(M)*N; 1975end); 1976############################################################################ 1977 1978############################################################################ 1979## 1980#M Comparisons 1981## 1982InstallMethod(\<, "(FR) for an FR element and a Mealy element", 1983 [IsFRElement, IsMealyElement], 1984 function(M,N) 1985 Info(InfoFR, 1, "\\<: converting second argument to FR element"); 1986 return M<AsSemigroupFRElement(N); 1987end); 1988 1989InstallMethod(\<, "(FR) for a Mealy element and an FR element", 1990 [IsMealyElement, IsFRElement], 1991 function(M,N) 1992 Info(InfoFR, 1, "\\<: converting first argument to FR element"); 1993 return AsSemigroupFRElement(M)<N; 1994end); 1995 1996InstallMethod(\=, "(FR) for an FR element and a Mealy element", 1997 [IsFRElement, IsMealyElement], 1998 function(M,N) 1999 Info(InfoFR, 1, "\\=: converting second argument to FR element"); 2000 return M=AsSemigroupFRElement(N); 2001end); 2002 2003InstallMethod(\=, "(FR) for a Mealy element and an FR element", 2004 [IsMealyElement, IsFRElement], 2005 function(M,N) 2006 Info(InfoFR, 1, "\\=: converting first argument to FR element"); 2007 return AsSemigroupFRElement(M)=N; 2008end); 2009############################################################################ 2010 2011############################################################################ 2012## 2013#M Inverse . . . . . . . . . . . . . . . . . . . . . . invert Mealy machine 2014#M One . . . . . . . . . . . . . . . . . . . . . .identity of Mealy machine 2015## 2016InstallMethod(IsInvertible, "(FR) for a Mealy machine", 2017 [IsMealyMachine and IsMealyMachineIntRep], 2018 M->ForAll(StateSet(M),i->ISINVERTIBLE@(M!.output[i]))); 2019 2020InstallMethod(IsInvertible, "(FR) for a Mealy element", 2021 [IsMealyElement and IsMealyMachineIntRep], 2022 M->ForAll(StateSet(M),i->ISINVERTIBLE@(M!.output[i]))); 2023 2024InstallMethod(IsGeneratorsOfMagmaWithInverses, "(FR) for a list of Mealy elements", 2025 [IsFRElementCollection], 2026 function(l) 2027 local i; 2028 for i in l do 2029 if not IsInvertible(i) then 2030 return false; 2031 fi; 2032 od; 2033 return true; 2034end); 2035 2036BindGlobal("SETINVERSENAME@", function(M,N) 2037 local n; 2038 if HasName(N) then 2039 n := Name(N); 2040 if not ForAll(n,IsAlphaChar) then 2041 n := Concatenation("(",n,")"); 2042 fi; 2043 if HasOrder(N) and Order(N)<infinity then 2044 SetName(M,Concatenation(n,"^",String(Order(N)-1))); 2045 else SetName(M,Concatenation(n,"^-1")); fi; 2046 fi; 2047end); 2048 2049InstallMethod(InverseOp, "(FR) for a Mealy machine", 2050 [IsMealyMachine], 2051 function(M) 2052 local s, out; 2053 if not IsInvertible(M) then return fail; fi; 2054 if HasOrder(M) and Order(M) = 2 then return M; fi; 2055 2056 out := List(M!.output,INVERSE@); 2057 s := MealyMachineNC(FamilyObj(M), 2058 List([1..M!.nrstates], i->M!.transitions[i]{out[i]}), 2059 out); 2060 SetInverse(M,s); SetInverse(s,M); 2061 if HasOrder(M) then SetOrder(s,Order(M)); fi; 2062 SETINVERSENAME@(s,M); 2063 return s; 2064end); 2065 2066InstallMethod(InverseOp, "(FR) for a Mealy element", 2067 [IsMealyElement], 2068 function(E) 2069 local s, out; 2070 if not IsInvertible(E) then return fail; fi; 2071 if HasOrder(E) and Order(E) = 2 then return E; fi; 2072 2073 out := List(E!.output,INVERSE@); 2074 s := MMMINIMIZE@(FamilyObj(E),AlphabetOfFRObject(E), 2075 E!.nrstates, 2076 List([1..E!.nrstates],i->E!.transitions[i]{out[i]}), 2077 out, 2078 E!.initial,2); 2079 SetInverse(E,s); SetInverse(s,E); 2080 if HasOrder(E) then SetOrder(s,Order(E)); fi; 2081 SETINVERSENAME@(s,E); 2082 return s; 2083end); 2084 2085InstallMethod(OneOp, "(FR) compute identity of Mealy element", 2086 [IsMealyElement and IsMealyMachineIntRep], 1, 2087 function(E) 2088 return MealyElementNC(FamilyObj(E),[List(AlphabetOfFRObject(E),i->1)],[AlphabetOfFRObject(E)],1); 2089end); 2090 2091InstallMethod(OneOp, "(FR) compute identity of Mealy machine", 2092 [IsMealyMachine and IsMealyMachineIntRep], 2093 function(M) 2094 return MealyMachineNC(FamilyObj(M),[List(AlphabetOfFRObject(M),i->1)],[AlphabetOfFRObject(M)]); 2095end); 2096 2097InstallMethod(OneOp, "(FR) for a Mealy machine in domain rep", 2098 [IsMealyMachine and IsMealyMachineDomainRep], 2099 function(M) 2100 return MealyMachine(Domain([1]), AlphabetOfFRObject(M), 2101 function(s,a) return s; end, function(s,a) return a; end); 2102end); 2103 2104InstallMethod(OneOp, "(FR) for a Mealy element in domain rep", 2105 [IsMealyElement and IsMealyMachineDomainRep], 2106 function(E) 2107 return MealyElement(Domain([1]), AlphabetOfFRObject(E), 2108 function(s,a) return s; end,function(s,a) return a; end, 1); 2109end); 2110 2111InstallMethod(ZeroOp, "(FR) compute trivial Mealy machine", 2112 [IsMealyMachine], 2113 function(M) 2114 return MealyMachineNC(FamilyObj(M),[],[]); 2115end); 2116############################################################################ 2117 2118############################################################################ 2119## 2120#M DualMachine 2121#P IsReversible 2122#P IsBireversible 2123## 2124BindGlobal("ALPHABETINVOLUTION@", function(N) 2125 local l; 2126 l := List(StateSet(N),x->FRElement(N,x)); 2127 l := List(l,x->Position(l,x^-1)); 2128 if fail in l then return fail; fi; 2129 return l; 2130end); 2131 2132InstallMethod(DualMachine, "(FR) for a Mealy machine in int rep", 2133 [IsMealyMachine and IsMealyMachineIntRep], 2134 function(M) 2135 local N, l; 2136 N := MealyMachineNC(FRMFamily(StateSet(M)), 2137 TransposedMat(M!.output), 2138 TransposedMat(M!.transitions)); 2139 if HasAlphabetInvolution(M) then 2140 l := ALPHABETINVOLUTION@(M); 2141 if l<>fail then 2142 SetAlphabetInvolution(N,l); 2143 fi; 2144 fi; 2145 return N; 2146end); 2147 2148InstallMethod(DualMachine, "(FR) for a Mealy machine in domain rep", 2149 [IsMealyMachine and IsMealyMachineDomainRep], 2150 function(M) 2151 return MealyMachine(StateSet(M),AlphabetOfFRObject(M), 2152 function(s,a) return M!.output(a,s); end, 2153 function(s,a) return M!.transitions(a,s); end); 2154end); 2155 2156InstallMethod(IsReversible, "(FR) for a Mealy machine", 2157 [IsMealyMachine], 2158 function(M) 2159 return IsInvertible(DualMachine(M)); 2160end); 2161 2162InstallMethod(IsBireversible, "(FR) for a Mealy machine", 2163 [IsFRMachine], 2164 function(M) 2165 local Minv; 2166 Minv := Inverse(M); 2167 return Minv<>fail and IsReversible(M) and IsReversible(Minv); 2168end); 2169 2170InstallTrueMethod(IsReversible, IsBireversible); 2171InstallTrueMethod(IsInvertible, IsBireversible); 2172 2173InstallMethod(AlphabetInvolution, "(FR) for a bireversible Mealy machine", 2174 [IsMealyMachine], 2175 function(M) 2176 if not IsBireversible(M) then 2177 return fail; 2178 fi; 2179 return ALPHABETINVOLUTION@(DualMachine(M)); 2180end); 2181 2182InstallMethod(IsMinimized, "(FR) for a Mealy machine", 2183 [IsMealyMachine and IsMealyMachineIntRep], 2184 function(M) 2185 return MMMINIMIZE@(FamilyObj(M),AlphabetOfFRObject(M), 2186 M!.nrstates,M!.transitions,M!.output,fail,0)!.nrstates=M!.nrstates; 2187end); 2188 2189InstallTrueMethod(IsMinimized, IsMealyElement and IsMealyMachineIntRep); 2190############################################################################ 2191 2192############################################################################ 2193## 2194#M StateGrowth 2195## 2196BindGlobal("STATEGROWTH@", function(M,z) 2197 local src, mat, dest, s, a, is, it, enum; 2198 src := []; 2199 enum := Enumerator(StateSet(M)); 2200 mat := IdentityMat(Size(enum))*z^0; 2201 dest := []; 2202 for s in enum do 2203 if IsMealyElement(M) and s <> InitialState(M) then 2204 Add(src,0); 2205 else 2206 Add(src,1); 2207 fi; 2208 if IsOne(FRElement(M,s)) then Add(dest,0); else Add(dest,1); fi; 2209 is := Position(enum,s); 2210 for a in AlphabetOfFRObject(M) do 2211 it := Position(enum,Transition(M,s,a)); 2212 mat[is][it] := mat[is][it]-z; 2213 od; 2214 od; 2215 return src*Inverse(mat)*dest; 2216end); 2217 2218InstallMethod(StateGrowth, "(FR) for a Mealy machine and an indeterminate", 2219 [IsMealyMachine, IsRingElement], 2220 STATEGROWTH@); 2221 2222InstallMethod(StateGrowth, "(FR) for a Mealy element and an indeterminate", 2223 [IsMealyElement, IsRingElement], 2224 STATEGROWTH@); 2225 2226InstallMethod(StateGrowth, "(FR) for a FR machine and an indeterminate", 2227 [IsFRMachine, IsRingElement], 2228 function(M,z) 2229 Info(InfoFR, 1, "StateGrowth: converting to Mealy machine"); 2230 return StateGrowth(ASINTREP@(M),z); 2231end); 2232 2233InstallMethod(StateGrowth, "(FR) for a FR element and an indeterminate", 2234 [IsFRElement, IsRingElement], 2235 function(M,z) 2236 Info(InfoFR, 1, "StateGrowth: converting to Mealy element"); 2237 return StateGrowth(ASINTREP@(M),z); 2238end); 2239 2240InstallMethod(StateGrowth, "(FR) for a FR object", 2241 [IsFRObject], 2242 function(M) 2243 return StateGrowth(M,Indeterminate(Rationals)); 2244end); 2245 2246BindGlobal("DEGREE_MEALYME@", function(M) 2247 local d, e, f, i, j, k, fM; 2248 M := Minimized(M); 2249 if IsOne(M) then return -1; fi; 2250 fM := BinaryRelationOnPointsNC(M!.transitions); 2251 f := StronglyConnectedComponents(fM); 2252 e := EquivalenceClasses(f); 2253 for i in e do 2254 if Size(i)=1 then 2255 j := Representative(i); 2256 if ISONE@(M!.output[j]) and 2257 ForAll(M!.transitions[j],k->k=j) then 2258 continue; # is identity element 2259 fi; 2260 fi; 2261 d := []; 2262 for j in i do d[j] := 0; od; 2263 for j in i do 2264 for k in M!.transitions[j] do 2265 if k in i then d[k] := d[k]+1; fi; 2266 od; 2267 od; 2268 if ForAny(d,x->x>=2) then return infinity; fi; 2269 od; 2270 d := []; 2271 for i in [1..Length(e)] do for j in e[i] do d[j] := i; od; od; 2272 i := List(e,i->[]); 2273 for j in StateSet(M) do for k in AlphabetOfFRObject(M) do 2274 Add(i[d[j]],d[M!.transitions[j][k]]); 2275 od; od; 2276 f := TransitiveClosureBinaryRelation(BinaryRelationOnPointsNC(i)); 2277 d := Filtered([1..Length(e)],x->x in Images(f,x)); 2278 e := []; 2279 while d<>[] do 2280 Add(e,Filtered(d,x->Intersection(Images(f,x),d)=[x])); 2281 d := Difference(d,e[Length(e)]); 2282 od; 2283 return Length(e)-1; 2284end); 2285InstallMethod(DegreeOfFRMachine, "(FR) for a Mealy machine", 2286 [IsMealyMachine and IsMealyMachineIntRep], 2287 DEGREE_MEALYME@); 2288InstallMethod(DegreeOfFRMachine, "(FR) for an FR machine", 2289 [IsFRMachine], 2290 function(M) 2291 Info(InfoFR, 1, "Degree: converting to Mealy machine"); 2292 return DEGREE_MEALYME@(ASINTREP@(M)); 2293end); 2294InstallMethod(DegreeOfFRElement, "(FR) for a Mealy element", 2295 [IsMealyElement and IsMealyMachineIntRep], 2296 DEGREE_MEALYME@); 2297InstallMethod(DegreeOfFRElement, "(FR) for an FR element", 2298 [IsFRElement], 2299 function(E) 2300 Info(InfoFR, 1, "Degree: converting to Mealy element"); 2301 return DEGREE_MEALYME@(ASINTREP@(E)); 2302end); 2303InstallMethod(Degree, [IsFRMachine], DegreeOfFRMachine); 2304InstallMethod(Degree, [IsFRElement], DegreeOfFRElement); 2305 2306BindGlobal("DEPTH_MEALYME@", function(M) 2307 local i, j, f, fM, one, d, todo; 2308 if IsOne(M) then return 0; fi; 2309 M := Minimized(M); 2310 one := First(StateSet(M),s->IsOne(FRElement(M,s))); 2311 if one=fail then return infinity; fi; 2312 fM := BinaryRelationOnPointsNC(M!.transitions); 2313 f := TransitiveClosureBinaryRelation(fM); 2314 for i in StateSet(M) do 2315 if i<>one and i in Images(f,i) then return infinity; fi; 2316 od; 2317 d := List(StateSet(M),s->0); 2318 todo := [one]; 2319 for i in todo do 2320 for j in PreImages(fM,i) do if j <> one then 2321 if d[j]<=d[i] then 2322 d[j] := d[i]+1; 2323 Add(todo,j); 2324 fi; 2325 fi; od; 2326 od; 2327 if IsMealyElement(M) then 2328 return d[M!.initial]; 2329 else 2330 return Maximum(d); 2331 fi; 2332end); 2333InstallMethod(DepthOfFRMachine, "(FR) for a Mealy machine", 2334 [IsMealyMachine and IsMealyMachineIntRep], 2335 DEPTH_MEALYME@); 2336InstallMethod(DepthOfFRMachine, "(FR) for an FR machine", 2337 [IsFRMachine], 2338 function(M) 2339 Info(InfoFR, 1, "Depth: converting to Mealy machine"); 2340 return DEPTH_MEALYME@(ASINTREP@(M)); 2341end); 2342InstallMethod(DepthOfFRElement, "(FR) for a Mealy element", 2343 [IsMealyElement and IsMealyMachineIntRep], 2344 DEPTH_MEALYME@); 2345InstallMethod(DepthOfFRElement, "(FR) for an FR element", 2346 [IsFRElement], 2347 function(E) 2348 Info(InfoFR, 1, "Depth: converting to Mealy element"); 2349 return DEPTH_MEALYME@(ASINTREP@(E)); 2350end); 2351InstallMethod(Depth, [IsFRMachine], DepthOfFRMachine); 2352InstallMethod(Depth, [IsFRElement], DepthOfFRElement); 2353 2354InstallMethod(IsFinitaryFRMachine, "(FR) for an FR machine", 2355 [IsFRMachine], 2356 M->DegreeOfFRMachine(M)<=0); 2357InstallMethod(IsFinitaryFRElement, "(FR) for an FR element", 2358 [IsFRElement], 2359 M->DegreeOfFRElement(M)<=0); 2360 2361InstallMethod(IsBoundedFRMachine, "(FR) for an FR machine", 2362 [IsFRMachine], 2363 M->DegreeOfFRMachine(M)<=1); 2364InstallMethod(IsBoundedFRElement, "(FR) for an FR element", 2365 [IsFRElement], 2366 M->DegreeOfFRElement(M)<=1); 2367 2368InstallMethod(IsPolynomialGrowthFRMachine, "(FR) for an FR machine", 2369 [IsFRMachine], 2370 M->DegreeOfFRMachine(M)<infinity); 2371InstallMethod(IsPolynomialGrowthFRElement, "(FR) for an FR element", 2372 [IsFRElement], 2373 M->DegreeOfFRElement(M)<infinity); 2374 2375InstallTrueMethod(IsFiniteStateFRMachine, IsMealyMachine); 2376InstallTrueMethod(IsFiniteStateFRElement, IsMealyElement); 2377InstallTrueMethod(IsBoundedFRElement, IsFinitaryFRElement); 2378InstallTrueMethod(IsBoundedFRMachine, IsFinitaryFRMachine); 2379InstallTrueMethod(IsPolynomialGrowthFRElement, IsBoundedFRElement); 2380InstallTrueMethod(IsPolynomialGrowthFRMachine, IsBoundedFRMachine); 2381InstallTrueMethod(IsFiniteStateFRElement, IsPolynomialGrowthFRElement); 2382InstallTrueMethod(IsFiniteStateFRMachine, IsPolynomialGrowthFRMachine); 2383############################################################################ 2384 2385############################################################################ 2386## 2387#M Guess Mealy machine 2388## 2389BindGlobal("SHRINKPERM@", function(perm,d,n) 2390 local l, m; 2391 2392 l := ListTransformation(perm,d^n); 2393 m := List(l{d*[1..d^(n-1)]},x->1+QuoInt(x-1,d)); 2394 2395 if ForAny([1..d^n],i->1+QuoInt(l[i]-1,d)<>m[1+QuoInt(i-1,d)]) then 2396 return fail; 2397 fi; 2398 if IsTransformation(perm) then 2399 return Transformation(m); 2400 else 2401 return TransformationList(m); 2402 fi; 2403end); 2404 2405BindGlobal("DECOMPPERM@", function(perm,d,n) 2406 local l, m, i, trans, out; 2407 2408 l := ListTransformation(perm,d^n); 2409 trans := []; 2410 out := []; 2411 for i in [1..d] do 2412 m := l{[1..d^(n-1)]+(i-1)*d^(n-1)}; 2413 Add(out,1+QuoInt(m[1]-1,d^(n-1))); 2414 if ForAny(m,x->1+QuoInt(x-1,d^(n-1))<>out[i]) then 2415 return fail; 2416 fi; 2417 Add(trans,m-d^(n-1)*(out[i]-1)); 2418 od; 2419 return [List(trans,Transformation),Transformation(out)]; 2420end); 2421 2422InstallOtherMethod(GuessMealyElement, "(FR) for a perm/trans, degree and depth", 2423 [IsObject, IsPosInt, IsInt], 2424 function(perm,d,n) 2425 local trans, out, level, s, i, j, k, x, dec; 2426 2427 trans := []; 2428 out := []; 2429 level := [n]; 2430 s := []; 2431 for i in [n,n-1..1] do 2432 s[i] := [perm]; 2433 perm := SHRINKPERM@(perm,d,i); 2434 od; 2435 i := 1; 2436 while i<=Length(level) do 2437 if level[i]=1 then 2438 return fail; # refuse to guess 2439 fi; 2440 Add(trans,[]); 2441 dec := DECOMPPERM@(s[level[i]][i],d,level[i]); 2442 Add(out,dec[2]); 2443 for j in [1..d] do 2444 x := Position(s[level[i]-1],dec[1][j]); 2445 if x=fail then 2446 if level[i]=1 then return fail; fi; 2447 Add(level,level[i]-1); 2448 for k in [level[i]-1,level[i]-2..1] do 2449 Add(s[k],dec[1][j]); 2450 dec[1][j] := SHRINKPERM@(dec[1][j],d,k); 2451 od; 2452 x := Length(level); 2453 elif Position(s[level[i]-1],dec[1][j],x)<>fail then 2454 return fail; # more than 1 match 2455 fi; 2456 Add(trans[i],x); 2457 od; 2458 i := i+1; 2459 od; 2460 return MealyElement(trans,out,1); 2461end); 2462############################################################################ 2463 2464############################################################################ 2465## 2466#M Signatures, transitivity, order 2467## 2468InstallMethod(Signatures, "(FR) for a Mealy element", 2469 [IsMealyElement and IsMealyMachineIntRep], 2470 function(E) 2471 local mat, dest, a, s, t, maker; 2472 mat := 0*IdentityMat(E!.nrstates); 2473 dest := []; 2474 if ForAll(E!.output,ISINVERTIBLE@) then 2475 maker := PermList; 2476 else 2477 maker := TransformationList; 2478 fi; 2479 for s in [1..E!.nrstates] do 2480 for t in E!.transitions[s] do 2481 mat[s][t] := mat[s][t]+1; 2482 od; 2483 Add(dest,maker(E!.output[s])); 2484 od; 2485 a := []; 2486 repeat 2487 Add(a,dest); 2488 dest := List([1..Length(dest)],i->Product([1..Length(dest)],j->dest[j]^mat[i][j])); 2489 until dest in a; 2490 return CompressedPeriodicList( 2491 List(a,v->v[Position(StateSet(E),InitialState(E))]), 2492 Position(a,dest)); 2493end); 2494INSTALLMEHANDLER@(Signatures,true); 2495 2496InstallMethod(VertexTransformationsFRMachine, "(FR) for an FR machine", 2497 [IsFRMachine], 2498 function(M) 2499 local t; 2500 t := List(GeneratorsOfFRMachine(M),s->Output(M,s)); 2501 if ForAll(t,ISINVERTIBLE@) then 2502 return Group(List(t,PermList)); 2503 else 2504 return Monoid(List(t,TransformationList)); 2505 fi; 2506end); 2507 2508InstallMethod(VertexTransformationsFRElement, "(FR) for an FR element", 2509 [IsFRElement], 2510 E->VertexTransformationsFRMachine(UnderlyingFRMachine(E))); 2511 2512InstallMethod(IsLevelTransitive, "(FR) for an FR element", 2513 [IsFRElement], 10, # easy 2514 function(E) 2515 if not IsAbelian(VertexTransformationsFRElement(E)) then 2516 TryNextMethod(); 2517 else 2518 return ForAll(Flat(Signatures(E)),x->IsTransitive(Group(x),AlphabetOfFRObject(E))); 2519 fi; 2520end); 2521 2522InstallMethod(IsLevelTransitive, "(FR) for a Mealy element", 2523 [IsMealyElement], 2524 function(E) 2525 local seen, d, c; 2526 seen := NewDictionary(E,false); 2527 while not KnowsDictionary(seen,E) do 2528 AddDictionary(seen,E); 2529 d := DecompositionOfFRElement(E); # could improve by reducing E by conjugation 2530 c := Cycle(PermList(d[2]),AlphabetOfFRObject(E),Representative(AlphabetOfFRObject(E))); 2531 if Set(c)<>AlphabetOfFRObject(E) then 2532 return false; 2533 fi; 2534 E := Product(d[1]{c}); 2535 od; 2536 return true; 2537end); 2538############################################################################ 2539 2540############################################################################# 2541## 2542#F AllMealyMachines 2543## 2544InstallGlobalFunction(AllMealyMachines, 2545 function(arg) 2546 local m, n, filters, vertex, creator, trans, out, F, t, o, 2547 proja, projs, list; 2548 m := arg[1]; 2549 n := arg[2]; 2550 filters := arg{[3..Length(arg)]}; 2551 if IsBireversible in filters then 2552 Append(filters,[IsInvertible,IsReversible]); 2553 fi; 2554 vertex := PositionProperty(filters,IsSemigroup); 2555 if vertex=fail then 2556 if IsInvertible in filters then 2557 vertex := SymmetricGroup(m); 2558 else 2559 vertex := FullTransformationSemigroup(m); 2560 fi; 2561 else 2562 vertex := Remove(filters,vertex); 2563 fi; 2564 if IsGroup(vertex) then 2565 creator := T->Group(List(T,PermList)); 2566 elif IsMonoid(vertex) then 2567 creator := T->Monoid(List(T,Transformation)); 2568 else 2569 creator := T->Semigroup(List(T,Transformation)); 2570 fi; 2571 if IsReversible in filters then 2572 Remove(filters,Position(filters,IsReversible)); 2573 trans := List(Tuples(Arrangements([1..n],n),m),TransposedMat); 2574 else 2575 trans := Tuples(Tuples([1..n],m),n); 2576 fi; 2577 out := []; 2578 for o in vertex do 2579 if IsTransformation(o) then 2580 Add(out,ListTransformation(o,m)); 2581 else 2582 Add(out,ListPerm(o,m)); 2583 fi; 2584 od; 2585 out := Tuples(out,n); 2586 if IsTransitive in filters then 2587 Remove(filters,Position(filters,IsTransitive)); 2588 out := Filtered(out,function(T) 2589 local rel; 2590 rel := BinaryRelationOnPointsNC(TransposedMat(T)); 2591 rel := StronglyConnectedComponents(rel); 2592 return Length(EquivalenceClasses(rel))=1; 2593 end); 2594 elif IsSurjective in filters then 2595 Remove(filters,Position(filters,IsSurjective)); 2596 out := Filtered(out,T->Size(creator(T))=Size(vertex)); 2597 fi; 2598 if IsBireversible in filters then 2599 Remove(filters,Position(filters,IsBireversible)); 2600 F := []; 2601 for t in trans do for o in out do 2602 if ForAll(TransposedMat(List([1..n],i->t[i]{o[i]})), 2603 r->Set(r)=[1..n]) then 2604 Add(F,[t,o]); 2605 fi; 2606 od; od; 2607 else 2608 F := Cartesian(trans,out); 2609 fi; 2610 list := EquivalenceClasses in filters; 2611 if list then 2612 Remove(filters,Position(filters,EquivalenceClasses)); 2613 o := DirectProduct(SymmetricGroup(m),SymmetricGroup(n)); 2614 proja := Projection(o,1); 2615 projs := Projection(o,2); 2616 F := List(Orbits(o,F,function(M,g) 2617 local ga, gs; 2618 ga := g^proja; 2619 gs := g^projs; 2620 return [Permuted(List(M[1],r->List(Permuted(r,ga),i->i^gs)),gs), 2621 Permuted(List(M[2],r->List(Permuted(r,ga),i->i^ga)),gs)]; 2622 end),Set); 2623 fi; 2624 if InverseClasses in filters then 2625 Remove(filters,Position(filters,InverseClasses)); 2626 if not list then 2627 F := List(F,x->[x]); 2628 list := true; 2629 fi; 2630 F := List(Orbits(SymmetricGroup(2),F,function(ML,g) 2631 if IsOne(g) or not ForAll(ML,M->ForAll(M[2],ISINVERTIBLE@)) then 2632 return ML; 2633 else 2634 return Set(ML,M->[List([1..Length(M[1])],i->M[1][i]{M[2][i]}), 2635 List(M[2],INVERSE@)]); 2636 fi; 2637 end),Representative); 2638 fi; 2639 if list then 2640 F := List(F,Representative); 2641 fi; 2642 m := FRMFamily([1..m]); 2643 F := List(F,p->MealyMachineNC(m,p[1],p[2])); 2644 for o in filters do 2645 F := Filtered(F,o); 2646 od; 2647 return F; 2648end); 2649############################################################################# 2650 2651############################################################################# 2652## 2653#M ConfinalityClasses 2654## 2655InstallMethod(ConfinalityClasses, "(FR) for a Mealy element", 2656 [IsMealyElement and IsMealyMachineIntRep], 2657 function(E) 2658 local recur, classes, states, source, dest, one; 2659 if not IsBoundedFRElement(E) then return fail; fi; 2660 one := First(StateSet(E),s->IsOne(FRElement(E,s))); 2661 recur := function(s) 2662 local a, i; 2663 if s=one then return; fi; 2664 2665 i := Position(states,s); 2666 if i=fail then 2667 Add(states,s); 2668 for a in AlphabetOfFRObject(E) do 2669 Add(source,a); Add(dest,Output(E,s,a)); 2670 recur(Transition(E,s,a)); 2671 Remove(source); Remove(dest); 2672 od; 2673 Remove(states); 2674 else 2675 i := [ConfinalityClass(PeriodicList(source,i)), 2676 ConfinalityClass(PeriodicList(dest,i))]; 2677 if i[1]<>i[2] then 2678 Add(classes,i); 2679 fi; 2680 fi; 2681 end; 2682 classes := []; 2683 states := []; source := []; dest := []; 2684 recur(InitialState(E)); 2685 if classes=[] then return []; fi; 2686 one := Domain(Set(Concatenation(classes))); 2687 one := EquivalenceRelationByPairs(one,classes); 2688 return EquivalenceClasses(one); 2689end); 2690INSTALLMEHANDLER@(ConfinalityClasses,true); 2691 2692InstallMethod(Germs, "(FR) for a Mealy element", 2693 [IsMealyElement], 2694 function(E) 2695 local recur, classes, states, path, one; 2696 if not IsBoundedFRElement(E) then return fail; fi; 2697 one := First(StateSet(E),s->IsOne(FRElement(E,s))); 2698 recur := function(s) 2699 local a, i; 2700 if s=one then return; fi; 2701 2702 i := Position(states,s); 2703 if i=fail then 2704 Add(states,s); 2705 for a in AlphabetOfFRObject(E) do 2706 Add(path,a); 2707 recur(Transition(E,s,a)); 2708 Remove(path); 2709 od; 2710 Remove(states); 2711 else 2712 Add(classes,[CompressedPeriodicList(path,i), 2713 CompressedPeriodicList(states,i)]); 2714 fi; 2715 end; 2716 classes := []; 2717 states := []; path := []; 2718 recur(InitialState(E)); 2719 return classes; 2720end); 2721INSTALLMEHANDLER@(Germs,true); 2722 2723InstallMethod(NormOfBoundedFRElement, "(FR) for a Mealy element", 2724 [IsMealyElement], 2725 function(E) 2726 local recur, states, one; 2727 if not IsBoundedFRElement(E) then return infinity; fi; 2728 one := First(StateSet(E),s->IsOne(FRElement(E,s))); 2729 recur := function(s) 2730 local a, i, n; 2731 if s=one then 2732 return 0; 2733 fi; 2734 n := 0; 2735 i := PositionSorted(states,s); 2736 if IsBound(states[i]) and states[i]=s then 2737 n := n+1; 2738 else 2739 Add(states,s,i); 2740 for a in AlphabetOfFRObject(E) do 2741 n := n + recur(Transition(E,s,a)); 2742 od; 2743 Remove(states,i); 2744 fi; 2745 return n; 2746 end; 2747 states := []; 2748 return recur(InitialState(E)); 2749end); 2750INSTALLMEHANDLER@(NormOfBoundedFRElement,true); 2751 2752InstallMethod(HasOpenSetConditionFRElement, "(FR) for a Mealy element", 2753 [IsMealyElement], 2754 function(E) 2755 local g; 2756 if not IsBoundedFRElement(E) then 2757 TryNextMethod(); # triggers an 'method not found' error 2758 fi; 2759 for g in Germs(E) do 2760 if g[1]^E=g[1] then return false; fi; 2761 od; 2762 return true; 2763end); 2764INSTALLMEHANDLER@(HasOpenSetConditionFRElement,true); 2765 2766InstallMethod(IsWeaklyFinitaryFRElement, "(FR) for a Mealy element", 2767 [IsMealyElement], 2768 function(E) 2769 local c; 2770 c := ConfinalityClasses(E); 2771 return c<>fail and c=[]; 2772end); 2773INSTALLMEHANDLER@(IsWeaklyFinitaryFRElement,true); 2774############################################################################# 2775 2776############################################################################# 2777## 2778#M LimitFRMachine 2779#M NucleusMachine 2780## 2781InstallMethod(LimitFRMachine, "(FR) for a Mealy machine", 2782 [IsMealyMachine and IsMealyMachineIntRep], 2783 function(M) 2784 local S, pos, i; 2785 S := MEALYLIMITSTATES@(M); 2786 pos := []; 2787 pos{S} := [1..Length(S)]; 2788 return MealyMachineNC(FamilyObj(M),List(M!.transitions{S},r->List(r,i->pos[i])),M!.output{S}); 2789end); 2790INSTALLMMHANDLER@(LimitFRMachine,true); 2791 2792InstallMethod(NucleusMachine, "(FR) for an FR machine", 2793 [IsFRMachine], 2794 function(M) 2795 local N, oldN, oldsize, size; 2796 M := LimitFRMachine(M); 2797 N := M; 2798 size := Size(StateSet(N)); 2799 repeat 2800 oldN := N; 2801 oldsize := size; 2802 N := Minimized(LimitFRMachine(N*M)); 2803 size := Size(StateSet(N)); 2804 if size=oldsize then return oldN; fi; 2805 Info(InfoFR, 2, "NucleusMachine: at least ",size," states"); 2806 until false; 2807end); 2808############################################################################# 2809 2810#E mealy.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here 2811