1)abbrev domain PERMGRP PermutationGroup 2++ Authors: G. Schneider, H. Gollan, J. Grabmeier 3++ Date Created: 13 February 1987 4++ Basic Operations: 5++ Related Constructors: PermutationGroupExamples, Permutation 6++ Also See: RepresentationTheoryPackage1 7++ AMS Classifications: 8++ Keywords: permutation, permutation group, group operation, word problem 9++ References: 10++ C. Sims: Determining the conjugacy classes of a permutation group, 11++ in Computers in Algebra and Number Theory, SIAM-AMS Proc., Vol. 4, 12++ Amer. Math. Soc., Providence, R. I., 1971, pp. 191-195 13++ Description: 14++ PermutationGroup implements permutation groups acting 15++ on a set S, i.e. all subgroups of the symmetric group of S, 16++ represented as a list of permutations (generators). Note that 17++ therefore the objects are not members of the \Language category 18++ \spadtype{Group}. 19++ Using the idea of base and strong generators by Sims, 20++ basic routines and algorithms 21++ are implemented so that the word problem for 22++ permutation groups can be solved. 23--++ Note: we plan to implement lattice operations on the subgroup 24--++ lattice in a later release 25 26PermutationGroup(S : SetCategory) : public == private where 27 28 L ==> List 29 PERM ==> Permutation 30 FSET ==> Set 31 I ==> Integer 32 NNI ==> NonNegativeInteger 33 V ==> Vector 34 B ==> Boolean 35 OUT ==> OutputForm 36 SYM ==> Symbol 37 REC ==> Record ( orb : L NNI, svc : V I ) 38 REC2 ==> Record(order : NNI, sgset : L V NNI, _ 39 gpbase : L NNI, orbs : V REC, mp : L S, wd : L L NNI) 40 REC3 ==> Record(elt : V NNI, lst : L NNI) 41 REC4 ==> Record(bool : B, lst : L NNI) 42 43 public ==> SetCategory with 44 45 coerce : % -> L PERM S 46 ++ coerce(gp) returns the generators of the group {\em gp}. 47 generators : % -> L PERM S 48 ++ generators(gp) returns the generators of the group {\em gp}. 49 elt : (%, NNI) -> PERM S 50 ++ elt(gp, i) returns the i-th generator of the group {\em gp}. 51 random : (%, I) -> PERM S 52 ++ random(gp, i) returns a random product of maximal i generators 53 ++ of the group {\em gp}. 54 random : % -> PERM S 55 ++ random(gp) returns a random product of maximal 20 generators 56 ++ of the group {\em gp}. 57 ++ Note: {\em random(gp)=random(gp, 20)}. 58 order : % -> NNI 59 ++ order(gp) returns the order of the group {\em gp}. 60 degree : % -> NNI 61 ++ degree(gp) returns the number of points moved by all permutations 62 ++ of the group {\em gp}. 63 base : % -> L S 64 ++ base(gp) returns a base for the group {\em gp}. 65 strongGenerators : % -> L PERM S 66 ++ strongGenerators(gp) returns strong generators for 67 ++ the group {\em gp}. 68 wordsForStrongGenerators : % -> L L NNI 69 ++ wordsForStrongGenerators(gp) returns the words for the strong 70 ++ generators of the group {\em gp} in the original generators of 71 ++ {\em gp}, represented by their indices in the list, given by 72 ++ {\em generators}. 73 coerce : L PERM S -> % 74 ++ coerce(ls) coerces a list of permutations {\em ls} to the group 75 ++ generated by this list. 76 permutationGroup : L PERM S -> % 77 ++ permutationGroup(ls) coerces a list of permutations {\em ls} to 78 ++ the group generated by this list. 79 orbit : (%, S) -> FSET S 80 ++ orbit(gp, el) returns the orbit of the element {\em el} under the 81 ++ group {\em gp}, i.e. the set of all points gained by applying 82 ++ each group element to {\em el}. 83 orbits : % -> FSET FSET S 84 ++ orbits(gp) returns the orbits of the group {\em gp}, i.e. 85 ++ it partitions the (finite) of all moved points. 86 orbit : (%, FSET S)-> FSET FSET S 87 ++ orbit(gp, els) returns the orbit of the unordered 88 ++ set {\em els} under the group {\em gp}. 89 orbit : (%, L S) -> FSET L S 90 ++ orbit(gp, ls) returns the orbit of the ordered 91 ++ list {\em ls} under the group {\em gp}. 92 ++ Note: return type is L L S temporarily because FSET L S has an error. 93 -- (GILT DAS NOCH?) 94 member? : (PERM S, %)-> B 95 ++ member?(pp, gp) answers the question, whether the 96 ++ permutation {\em pp} is in the group {\em gp} or not. 97 wordInStrongGenerators : (PERM S, %)-> L NNI 98 ++ wordInStrongGenerators(p, gp) returns the word for the 99 ++ permutation p in the strong generators of the group {\em gp}, 100 ++ represented by the indices of the list, given by 101 ++ {\em strongGenerators}. 102 wordInGenerators : (PERM S, %)-> L NNI 103 ++ wordInGenerators(p, gp) returns the word for the permutation p 104 ++ in the original generators of the group {\em gp}, 105 ++ represented by the indices of the list, given by {\em generators}. 106 movedPoints : % -> FSET S 107 ++ movedPoints(gp) returns the points moved by the group {\em gp}. 108 "<" : (%,%) -> B 109 ++ gp1 < gp2 returns true if and only if {\em gp1} 110 ++ is a proper subgroup of {\em gp2}. 111 "<=" : (%,%) -> B 112 ++ gp1 <= gp2 returns true if and only if {\em gp1} 113 ++ is a subgroup of {\em gp2}. 114 ++ Note: because of a bug in the parser you have to call this 115 ++ function explicitly by {\em gp1 <=$(PERMGRP S) gp2}. 116 -- (GILT DAS NOCH?) 117 initializeGroupForWordProblem : % -> Void 118 ++ initializeGroupForWordProblem(gp) initializes the group {\em gp} 119 ++ for the word problem. 120 ++ Notes: it calls the other function of this name with parameters 121 ++ 0 and 1: {\em initializeGroupForWordProblem(gp, 0, 1)}. 122 ++ Notes: (1) be careful: invoking this routine will destroy the 123 ++ possibly information about your group (but will recompute it again) 124 ++ (2) users need not call this function normally for the soultion of 125 ++ the word problem. 126 initializeGroupForWordProblem : (%, I, I) -> Void 127 ++ initializeGroupForWordProblem(gp, m, n) initializes the group 128 ++ {\em gp} for the word problem. 129 ++ Notes: (1) with a small integer you get shorter words, but the 130 ++ routine takes longer than the standard routine for longer words. 131 ++ (2) be careful: invoking this routine will destroy the possibly stored 132 ++ information about your group (but will recompute it again). 133 ++ (3) users need not call this function normally for the soultion of 134 ++ the word problem. 135 relationsInStrongGenerators : % -> L(L(I)) 136 ++ relationsInStrongGenerators(gp) computes relations between 137 ++ strong generators. 138 relationsInGenerators : % -> L(L(I)) 139 ++ relationsInGenerators(gp) computes relations between 140 ++ generators. 141 pointList : % -> L S 142 ++ pointList(gp) should be local but conditional 143 perm_to_vec : (L S, PERM S, NNI) -> V NNI 144 ++ perm_to_vec(supp, p, degree) should be local but conditional 145 private ==> add 146 147 -- representation of the object: 148 149 Rep := Record(gens : L PERM S, information : REC2) 150 151 -- import of domains and packages 152 153 import from Permutation S 154 import from OutputForm 155 import from Symbol 156 import from Void 157 158 --local functions first, signatures: 159 160 shortenWord : (L NNI, %)->L NNI 161 times : (V NNI, V NNI)->V NNI 162 orbitInternal : (%, L S )->L L S 163 inv : V NNI->V NNI 164 ranelt : (L V NNI, L L NNI, I)->REC3 165 testIdentity : V NNI->B 166 orbitWithSvc : (L V NNI, NNI )->REC 167 bsgs1 : (L V NNI, NNI, L L NNI, I, %, I)->NNI 168 initialize : %->FSET PERM S 169 knownGroup? : %->Void 170 subgroup : (%, %)->B 171 memberInternal : (PERM S, %, B)->REC4 172 173 --local functions first, implementations: 174 175 shortenWord ( lw : L NNI, gp : % ) : L NNI == 176 -- tries to shorten a word in the generators by removing identities 177 gpgens : L PERM S := coerce gp 178 orderList : L NNI := [ order gen for gen in gpgens ] 179 newlw : L NNI := copy lw 180 for i in 1.. maxIndex orderList repeat 181 if orderList.i = 1 then 182 while member?(i, newlw) repeat 183 -- removing the trivial element 184 pos := position(i, newlw) 185 newlw := delete(newlw, pos) 186 #newlw < 2 => newlw 187 test := first(newlw) 188 anzahl : NNI := 0 189 flag1 : B := true 190 do_res : B := false 191 res : L NNI 192 while flag1 repeat 193 test := first(newlw) 194 anzahl := 1 195 if do_res then res := [test] 196 flag2 : B := true 197 for el in newlw while flag2 repeat 198 if do_res then res := cons(el, res) 199 anzahl := anzahl + 1 200 anzahl = 1 => test := el 201 test ~= el => 202 test := el 203 anzahl := 1 204 anzahl = orderList.test => 205 if do_res then 206 res := rest(res, anzahl) 207 else 208 flag2 := false 209 anzahl := 0 210 if do_res then 211 newlw := reverse!(res) 212 flag1 := do_res 213 do_res := not(flag2) 214 newlw 215 216 -- internal multiplication of permutations 217 times!(res : V NNI, p : V NNI, q : V NNI) : Void == 218 degree := #p 219 for i in 1..degree repeat 220 qsetelt!(res, i, qelt(p, qelt(q, i))) 221 222 times ( p : V NNI, q : V NNI ) : V NNI == 223 degree := #p 224 res : V NNI := new(degree, 0) 225 times!(res, p, q) 226 res 227 228 -- internal inverse of a permutation 229 inv ( p : V NNI ) : V NNI == 230 degree := #p 231 q : V NNI := new(degree, 0)$(V NNI) 232 for i in 1..degree repeat qsetelt!(q, (qelt(p, i)), i) 233 q 234 235 -- internal test for identity 236 testIdentity ( p : V NNI ) : B == 237 degree := #p 238 for i in 1..degree repeat qelt(p, i) ~= i => return false 239 true 240 241 cosetRep1(ppt : NNI, do_words : Boolean, o : REC, grpv : V V NNI, 242 wordv : V L NNI) : REC3 == 243 #grpv = 0 => error "cosetRep needs nonempty group" 244 degree := #(grpv(1)) 245 xelt : V NNI := [ n for n in 1..degree ] 246 word := []$(L NNI) 247 oorb := o.orb 248 osvc := o.svc 249 p := qelt(osvc, ppt) 250 p < 0 => return [xelt, word] 251 tmpv : V NNI := new(degree, 0) 252 repeat 253 x := qelt(grpv, p) 254 times!(tmpv, x, xelt) 255 (tmpv, xelt) := (xelt, tmpv) 256 if do_words then word := append(wordv.p, word) 257 ppt := qelt(x, ppt) 258 p := qelt(osvc, ppt) 259 p < 0 => return [xelt, word] 260 261 strip1(element : V NNI, orbit : REC, group : L V NNI, words : L L NNI 262 ) : REC3 == 263 grpv := vector(group)$Vector(V NNI) 264 wordv : V L NNI := empty() 265 do_words := not(empty?(words)) 266 if do_words then 267 wordv := vector(words) 268 point := qelt(element, qelt(orbit.orb, 1)) 269 cr := cosetRep1(point, do_words, orbit, grpv, wordv) 270 [times(cr.elt, element), reverse(cr.lst)]$REC3 271 272 strip(z : V NNI, i : I, do_words : Boolean, 273 orbs : V REC, grpv : V V NNI, wordv : V L NNI) : REC3 == 274 degree := #z 275 word := []$(L NNI) 276 tmpv : V NNI := new(degree, 0) 277 noresult : Boolean := true 278 for j in i..1 by -1 while noresult repeat 279 orbj := qelt(orbs, j) 280 s := orbj.svc 281 p := first(orbj.orb) 282 while noresult repeat 283 entry := qelt(s, qelt(z, p)) 284 if entry < 0 then 285 if entry = -1 then break 286 noresult := false 287 else 288 ee := qelt(grpv, entry) 289 times!(tmpv, ee, z) 290 (z, tmpv) := (tmpv, z) 291 if do_words then word := append(wordv.entry, word) 292 [z, word] 293 294 orbitInternal(gp : %, startList : L S) : L L S == 295 orbitList : L L S := [ startList ] 296 pos : I := 1 297 while not zero? pos repeat 298 gpset : L PERM S := gp.gens 299 for gen in gpset repeat 300 newList := []$(L S) 301 workList := orbitList.pos 302 for j in #workList..1 by -1 repeat 303 newList := cons(eval(gen, workList.j), newList) 304 if not member?( newList, orbitList ) then 305 orbitList := cons(newList, orbitList) 306 pos := pos + 1 307 pos := pos - 1 308 reverse orbitList 309 310 ranelt(group : L V NNI, word : L L NNI, maxLoops : I) : REC3 == 311 -- generate a "random" element 312 numberOfGenerators := # group 313 randomInteger : I := 1 + random(numberOfGenerators)$Integer 314 randomElement : V NNI := group.randomInteger 315 words := []$(L NNI) 316 do_words : Boolean := not(empty?(word)) 317 if do_words then words := word.(randomInteger::NNI) 318 if maxLoops > 0 then 319 numberOfLoops : I := 1 + random(maxLoops)$Integer 320 else 321 numberOfLoops : I := maxLoops 322 while numberOfLoops > 0 repeat 323 randomInteger : I := 1 + random(numberOfGenerators)$Integer 324 randomElement := times(group.randomInteger, randomElement) 325 if do_words then words := append(word.(randomInteger::NNI), words) 326 numberOfLoops := numberOfLoops - 1 327 [randomElement, words] 328 329 if S has OrderedSet then 330 pointList(group : %) : L S == 331 not(empty?(group.information.mp)) => group.information.mp 332 support : L S := [] 333 for perm in group.gens repeat 334 support := merge(sort((listRepresentation perm).preimage), 335 support) 336 res : L S := [] 337 empty?(support) => res 338 p0 := first(support) 339 res := [p0] 340 for p in rest(support) repeat 341 p = p0 => "iterate" 342 p0 := p 343 res := cons(p, res) 344 group.information.mp := reverse!(res) 345 else 346 pointList(group : %) : L S == 347 not(empty?(group.information.mp)) => group.information.mp 348 support : FSET S := empty() 349 for perm in group.gens repeat 350 support := union(support, movedPoints perm) 351 group.information.mp := parts support 352 353 if S has OrderedSet then 354 REC5 ==> Record(preimage : NNI, image : S) 355 ls_to_lnni(ls : L S, supp : L S) : L NNI == 356 empty?(ls) => [] 357 ls2 := [[i, p]$REC5 for p in ls for i in 1..] 358 ls2 := sort((x : REC5, y : REC5) : Boolean +-> 359 x.image <= y.image, 360 ls2) 361 pel := first(ls2) 362 p1 := pel.image 363 ls2 := rest(ls2) 364 rp2 : L L NNI := [] 365 flag : Boolean := true 366 for p2 in supp for i in 1.. while flag repeat 367 if p1 = p2 then 368 rp2 := cons([pel.preimage, i], rp2) 369 empty?(ls2) => flag := false 370 pel := first(ls2) 371 p1 := pel.image 372 ls2 := rest(ls2) 373 rp2 := sort((x : L NNI, y : L NNI) : Boolean +-> 374 first(x) <= first(y), 375 rp2) 376 [second(pp) for pp in rp2] 377 378 perm_to_vec(supp : L S, p : PERM S, degree : NNI) : V NNI == 379 pr := listRepresentation p 380 q := new(degree, 0)$(V NNI) 381 for i in 1..degree repeat 382 q(i) := i 383 pl := ls_to_lnni(pr.preimage, supp) 384 il := ls_to_lnni(pr.image, supp) 385 for pp in pl for ip in il repeat 386 q(pp) := ip 387 q 388 else 389 perm_to_vec(supp : L S, p : PERM S, degree : NNI) : V NNI == 390 q := new(degree, 0)$(V NNI) 391 for i in 1..degree repeat 392 newEl := eval(p, supp.i) 393 pos2 := position(newEl, supp) 394 q.i := qcoerce(pos2) 395 q 396 397 orbitWithSvc1(group : L V NNI, grpinv : L V NNI, point : NNI) : REC == 398 -- compute orbit with Schreier vector, "-2" means not in the orbit, 399 -- "-1" means starting point, the PI correspond to generators 400 degree := #(first(group)) 401 orbit : L NNI := [ point ] 402 orbitv : V NNI := new(degree, 0) 403 orbitv(1) := point 404 orbit_size : NNI := 1 405 schreierVector : V I := new ( degree, -2 ) 406 schreierVector.point := -1 407 position : I := 1 408 while not zero? position repeat 409 for i in 1..#grpinv for grv in grpinv repeat 410 newPoint := qelt(orbitv, orbit_size - position + 1) 411 newPoint := qelt(grv, newPoint) 412 if qelt(schreierVector, newPoint) = -2 then 413 orbit := cons ( newPoint, orbit ) 414 orbit_size := orbit_size + 1 415 orbitv(orbit_size) := newPoint 416 position := position + 1 417 schreierVector.newPoint := i 418 position := position - 1 419 [reverse!(orbit), schreierVector ] 420 421 orbitWithSvc(group : L V NNI, point : NNI) : REC == 422 grpinv := []$(L V NNI) 423 for el in group repeat 424 grpinv := cons(inv el, grpinv) 425 grpinv := reverse grpinv 426 orbitWithSvc1(group, grpinv, point) 427 428 bsgs1(group : L V NNI, number1 : NNI, words : L L NNI, maxLoops : I, 429 gp : %, diff : I, out : Reference(L L V NNI), 430 outword : Reference(L L L NNI)) : NNI == 431 -- try to get a good approximation for the strong generators and base 432 degree := #(first(group)) 433 gp_info := gp.information 434 wordProblem : Boolean := not(empty?(words)) 435 -- i := find moved point 436 for i in number1..degree repeat 437 ort := orbitWithSvc(group, i) 438 k := ort.orb 439 k1 := # k 440 if k1 ~= 1 then break 441 gpsgs := []$(L V NNI) 442 words2 := []$(L L NNI) 443 gplength : NNI := #group 444 -- j := nontrivial element 445 for jj in 1..gplength repeat if (group.jj).i ~= i then break 446 for k in 1..gplength repeat 447 el2 := group.k 448 if el2.i ~= i then 449 gpsgs := cons(el2, gpsgs) 450 if wordProblem then words2 := cons(words.k, words2) 451 else 452 gpsgs := cons(times(group.jj, el2), gpsgs) 453 if wordProblem then 454 words2 := cons(append(words.jj, words.k), words2) 455 group2 := []$(L V NNI) 456 words3 := []$(L L NNI) 457 j : I := 15 458 while j > 0 repeat 459 -- find generators for the stabilizer 460 ran := ranelt(group, words, maxLoops) 461 str := strip1(ran.elt, ort, group, words) 462 el2 := str.elt 463 if not testIdentity el2 then 464 if not member?(el2, group2) then 465 group2 := cons ( el2, group2 ) 466 if wordProblem then 467 help : L NNI := append(reverse str.lst, ran.lst) 468 help := shortenWord(help, gp) 469 words3 := cons(help, words3) 470 j := j - 2 471 j := j - 1 472 -- this is for word length control 473 if wordProblem then maxLoops := maxLoops - diff 474 if empty?(group2) or (maxLoops < 0) then 475 gp_info.gpbase := [i] 476 setref(out, [gpsgs]) 477 setref(outword, [words2]) 478 return k1 479 k2 := bsgs1(group2, i + 1, words3, maxLoops, gp, diff, 480 out, outword) 481 sizeOfGroup : NNI := k1 * k2 482 setref(out, append(deref(out), [gpsgs])) 483 setref(outword, append(deref(outword), [words2])) 484 gp_info.gpbase := cons(i, gp_info.gpbase) 485 sizeOfGroup 486 487 reduceGenerators(kkk : I, do_words : Boolean, gp_info : REC2, 488 outl : L L V NNI, outword : L L L NNI) : L V NNI == 489 -- try to reduce number of strong generators 490 base_lst := gp_info.gpbase 491 orbv := gp_info.orbs 492 sgs : L V NNI := [] 493 res : L V NNI := [] 494 grpinv := []$(L V NNI) 495 for i in 1..kkk repeat 496 sgs := append(sgs, outl(i)) 497 grpinv := append(grpinv, map(inv, outl(i))) 498 removedGenerator : Boolean := false 499 baseLength : NNI := #base_lst 500 pt := baseLength - kkk + 1 501 obs := orbitWithSvc1(sgs, grpinv, base_lst(pt)) 502 orbv(kkk) := obs 503 obs_len := # obs.orb 504 if obs_len = 1 then 505 removedGenerator := true 506 outl(kkk) := [] 507 i := 1 508 outlk := outl(kkk) 509 while not (i > # outlk) and # outlk > 1 repeat 510 pos := position(outlk(i), sgs) 511 sgs2 := delete(sgs, pos) 512 grpinv2 := delete(grpinv, pos) 513 obs2 := orbitWithSvc1(sgs2, grpinv2, base_lst(pt)) 514 if # obs2.orb = obs_len then 515 res := cons(outlk(i), res) 516 sgs := sgs2 517 grpinv := grpinv2 518 outlk := delete(outlk, i) 519 outl(kkk) := outlk 520 orbv(kkk) := obs2 521 if do_words then _ 522 outword(kkk) := delete(outword(kkk), i) 523 else 524 i := i + 1 525 res 526 527 528 bsgs(group : %, wordProblem : Boolean, maxLoops : I, diff : I) : NNI == 529 -- the MOST IMPORTANT part of the package 530 basePoint : NNI := 0 531 newBasePoint : B := false 532 baseOfGroup : L NNI := [] 533 out : L L V NNI := [] 534 outword : L L L NNI := [] 535 outr : Reference(L L V NNI) := ref([]) 536 outwordr : Reference(L L L NNI) := ref([]) 537 supp := pointList group 538 degree := # supp 539 gp_info := [1, [], [], [], [], []]$REC2 540 if degree = 0 then 541 group.information := gp_info 542 return 1 543 newGroup := []$(L V NNI) 544 tmpv : V NNI := new(degree, 0) 545 gp : L PERM S := group.gens 546 words := []$(L L NNI) 547 for ggg in 1..#gp for ggp in gp repeat 548 q := perm_to_vec(supp, ggp, degree) 549 newGroup := cons(q, newGroup ) 550 if wordProblem then words := cons(list ggg, words) 551 if maxLoops < 1 then 552 -- try to get the (approximate) base length 553 if zero? (# ((group.information).gpbase)) then 554 k := bsgs1(newGroup, 1, []$(L L NNI), 20, group, 0, 555 outr, outwordr) 556 maxLoops := #((group.information).gpbase) - 1 557 k := bsgs1(newGroup, 1, words, maxLoops, group, diff, outr, outwordr) 558 out := deref(outr) 559 outword := deref(outwordr) 560 kkk : I := 1 561 newGroup := reverse newGroup 562 noAnswer : B := true 563 z : V NNI 564 add_cnt : I := 0 565 wordlist : L L NNI 566 dummy_rec : REC := [[], empty()] 567 baseOfGroup := (group.information).gpbase 568 gp_info.gpbase := baseOfGroup 569 orbv : V REC := new(# baseOfGroup, dummy_rec)$(V REC) 570 while noAnswer repeat 571 gp_info.gpbase := baseOfGroup 572 gp_info.orbs := orbv 573 -- test whether we have a base and a strong generating set 574 sgs : L V NNI := [] 575 wordlist := [] 576 for i in 1..(kkk-1) repeat 577 sgs := append(sgs, out.i) 578 if wordProblem then wordlist := append (wordlist, outword.i) 579 noresult : B := true 580 z := new(degree, 0) 581 for i in kkk..#baseOfGroup while noresult repeat 582 rejects := reduceGenerators(i, wordProblem, gp_info, 583 out, outword) 584 sgs := append(sgs, out.i) 585 sgsv := vector(sgs)$V(V NNI) 586 wordv : V L NNI := empty() 587 if wordProblem then 588 wordlist := append(wordlist, outword.i) 589 wordv := vector(wordlist) 590 gporbi := orbv(i) 591 for z0 in rejects while noresult repeat 592 z := copy(z0) 593 ppp := strip(z, i, false, orbv, sgsv, wordv) 594 noresult := testIdentity ppp.elt 595 if not(noresult) then 596 if wordProblem then 597 z := copy(z0) 598 ppp := strip(z, i, true, orbv, sgsv, wordv) 599 z := ppp.elt 600 word := ppp.lst 601 for pt in gporbi.orb while noresult repeat 602 ppp := cosetRep1(pt, wordProblem, gporbi, sgsv, wordv) 603 y1 := inv ppp.elt 604 word3 := ppp.lst 605 for jjj in 1..#sgs while noresult repeat 606 word := []$(L NNI) 607 times!(z, qelt(sgsv, jjj), y1) 608 if wordProblem then word := qelt(wordv, jjj) 609 ppp := strip(z, i, false, orbv, sgsv, wordv) 610 z := ppp.elt 611 noresult := testIdentity z 612 if not(noresult) and wordProblem then 613 z := times (qelt(sgsv, jjj), y1) 614 ppp := strip(z, i, true, orbv, sgsv, wordv) 615 z := ppp.elt 616 word := append(ppp.lst, word) 617 if not(noresult) then 618 for p in baseOfGroup for ii in 1.. repeat 619 basePoint := 1 620 newBasePoint := true 621 if qelt(z, p) ~= p then 622 newBasePoint := false 623 basePoint := (#baseOfGroup - ii + 1)::NNI 624 break 625 noAnswer := not (testIdentity z) 626 if noAnswer then 627 add_cnt := add_cnt + 1 628 -- we have missed something 629 word2 := []$(L NNI) 630 if wordProblem then 631 for wdi in word3 repeat 632 ttt := newGroup.wdi 633 while not (testIdentity ttt) repeat 634 word2 := cons(wdi, word2) 635 ttt := times(ttt, newGroup.wdi) 636 word := append(word, word2) 637 word := shortenWord(word, group) 638 if newBasePoint then 639 for i in 1..degree repeat 640 if z.i ~= i then 641 baseOfGroup := append(baseOfGroup, [ i ]) 642 break 643 orbv := new(# baseOfGroup, dummy_rec)$(V REC) 644 out := cons(list z, out) 645 if wordProblem then outword := cons(list word, outword) 646 else 647 out.basePoint := cons(z, out.basePoint) 648 if wordProblem then 649 outword.basePoint := cons(word, outword.basePoint) 650 kkk := basePoint 651 sizeOfGroup : NNI := 1 652 for j in 1..#baseOfGroup repeat 653 sizeOfGroup := sizeOfGroup * # orbv(j).orb 654 group.information := [sizeOfGroup, sgs, baseOfGroup, orbv, supp, 655 wordlist]$REC2 656 sizeOfGroup 657 658 659 initialize(group : %) : FSET PERM S == 660 group2 := empty()$(FSET PERM S) 661 gp : L PERM S := group.gens 662 for gen in gp repeat 663 if degree gen > 0 then insert!(gen, group2) 664 group2 665 666 knownGroup?(gp : %) : Void == 667 -- do we know the group already? 668 if gp.information.order = 0 then 669 bsgs(gp, false, 20, 0) 670 void 671 672 subgroup(gp1 : %, gp2 : %) : B == 673 gpset1 := initialize gp1 674 gpset2 := initialize gp2 675 empty? difference(gpset1, gpset2) => true 676 for el in parts gpset1 repeat 677 not member?(el, gp2) => return false 678 true 679 680 memberInternal(p : PERM S, gp : %, do_words : B) : REC4 == 681 -- internal membership testing 682 gr_supp := pointList gp 683 mP : L S := parts movedPoints p 684 gp_info : REC2 685 for x in mP repeat 686 not member?(x, gr_supp) => 687 return [false, []$(L NNI)] 688 if not(do_words) then 689 member?(p, gp.gens) => return [true, []$(L NNI)] 690 knownGroup? gp 691 gp_info := gp.information 692 sgsl := gp_info.sgset 693 orbv := gp_info.orbs 694 base_lst := gp_info.gpbase 695 degree : NNI := #gr_supp 696 697 pp := perm_to_vec(gr_supp, p, degree) 698 699 wordv : V L NNI := empty() 700 if do_words then 701 wordv := new(#sgsl, []) 702 for i in 1..#sgsl repeat 703 wordv(i) := [i] 704 grpv : V V NNI := vector(sgsl) 705 str := strip(pp, #base_lst, do_words, orbv, grpv, wordv) 706 [testIdentity str.elt, str.lst] 707 708 orbit_words1(p0 : NNI, p : NNI, grp : L V NNI, acc : L NNI, res : V L NNI 709 ) : Void == 710 for g in grp for i in 1.. repeat 711 q := qelt(g, p) 712 p0 = q => "skip" 713 not(empty?(qelt(res, q))) => "skip" 714 acc1 := cons(qcoerce(i)@NNI, acc) 715 res(q) := acc1 716 orbit_words1(p0, q, grp, acc1, res) 717 718 orbit_words(p : NNI, grp : L V NNI) : V L NNI == 719 n := #first(grp) 720 res := new(n, [])$(V L NNI) 721 orbit_words1(p, p, grp, [], res) 722 res 723 724 relations_for_orbit(p : NNI, m : NNI, orbd : V REC, 725 grpv : V V NNI) : L L I == 726 -- print("relations_for_orbit"::OutputForm) 727 -- print(p::OutputForm) 728 res : L L I := [] 729 grpl := first(members(grpv), m) 730 ww := orbit_words(p, grpl) 731 -- print(ww::OutputForm) 732 n0 := #(orbd(1).svc) 733 wv := new(n0, empty()$Vector(NNI))$(V V NNI) 734 wvi := new(n0, empty()$Vector(NNI))$(V V NNI) 735 wordv := new(n0, empty())$(V L NNI) 736 for i in 1..n0 repeat 737 wordv(i) := [i] 738 wi_l := qelt(ww, i) 739 empty?(wi_l) => "skip" 740 wi := new(n0, 0)$Vector(NNI) 741 for j in 1..n0 repeat 742 qsetelt!(wi, j, j) 743 for j in reverse(wi_l) repeat 744 times!(wi, qelt(grpv, j), wi) 745 qsetelt!(wv, i, wi) 746 qsetelt!(wvi, i, inv(wi)) 747 for i in 1..n0 repeat 748 wi_l := qelt(ww, i) 749 empty?(wi_l) => "skip" 750 -- print("wi_l = "::OutputForm) 751 -- print(wi_l::OutputForm) 752 wi := qelt(wv, i) 753 for j in 1..m repeat 754 -- print("doing"::OutputForm) 755 -- print(j::OutputForm) 756 nw := times(grpv(j), wi) 757 p1 := qelt(nw, p) 758 iw : L NNI := [] 759 if p1 ~= p then 760 nw := times(wvi(p1), nw) 761 iw := ww(p1) 762 cons(j, wi_l) = iw => "skip" 763 nw := inv(nw) 764 rhr := strip(nw, #orbd, true, orbd, grpv, wordv) 765 rh := concat(iw, rhr.lst) 766 -- print(rh::OutputForm) 767 rl : L I := [] 768 for k in rh repeat 769 rl := cons(-k, rl) 770 ll : L I := [] 771 for k in qelt(ww, i) repeat 772 ll := cons(k, ll) 773 ll := reverse!(ll) 774 rl := concat(ll, rl) 775 rl := cons(j, rl) 776 -- print(rl::OutputForm) 777 res := cons(rl, res) 778 res 779 780 relations_in_strong_generators(orbd : V REC, grpv : V V NNI 781 ) : L L I == 782 k := #orbd 783 m := #grpv 784 res : L L I := [] 785 bl : L NNI := [] 786 for i in 1..k repeat 787 orbi := qelt(orbd, i) 788 bl := cons(first(orbi.orb), bl) 789 gri_l : L NNI := [m] 790 blp := bl 791 -- print(blp::OutputForm) 792 p1 := first(blp) 793 blp := rest(blp) 794 for j in m..1 by -1 repeat 795 gv := qelt(grpv, j) 796 p2 := qelt(gv, p1) 797 -- print(p2::OutputForm) 798 if p1 = p2 then 799 gri_l := cons(j, gri_l) 800 empty?(blp) => break 801 p1 := first(blp) 802 blp := rest(blp) 803 -- print(gri_l :: OutputForm) 804 for p0 in reverse(bl) for m1 in gri_l repeat 805 res := concat(relations_for_orbit(p0, m1, orbd, grpv), res) 806 res 807 808 --now the exported functions 809 810 relationsInStrongGenerators(gp : %) : L(L(I)) == 811 knownGroup?(gp) 812 gi := gp.information 813 grpv := vector(gi.sgset)$V(V(NNI)) 814 relations_in_strong_generators(gi.orbs, grpv) 815 816 relationsInGenerators(gp : %) : L(L(I)) == 817 gi := gp.information 818 if #(gi.wd) = 0 then 819 initializeGroupForWordProblem(gp) 820 gi := gp.information 821 grpv := vector(gi.sgset)$V(V(NNI)) 822 orbd := gi.orbs 823 srels := relations_in_strong_generators(orbd, grpv) 824 words := new(#(gi.wd), empty())$V(L(I)) 825 iwords := new(#words, empty())$V(L(I)) 826 for i in 1..#words for wli in gi.wd repeat 827 words(i) := [j for j in wli] 828 iwd := []$L(I) 829 for j in wli repeat 830 iwd := cons(-j, iwd) 831 iwords(i) := iwd 832 res : L(L(I)) := [] 833 for srel in srels repeat 834 nrel : L(I) := [] 835 for i in srel repeat 836 cw := 837 i > 0 => qelt(words, i) 838 qelt(iwords, -i) 839 for j in cw repeat 840 nrel := cons(j, nrel) 841 res := cons(reverse!(nrel), res) 842 supp := pointList(gp) 843 nn := #supp 844 n0 := #grpv 845 wordv := new(n0, empty())$(V L NNI) 846 for i in 1..n0 repeat 847 wordv(i) := [i] 848 for i in 1..#words for ggp in gp.gens repeat 849 q := perm_to_vec(supp, ggp, nn) 850 rhr := strip(q, #orbd, true, orbd, grpv, wordv) 851 nrel : L(I) := [] 852 for j in rhr.lst repeat 853 cw := words(j) 854 for k in cw repeat 855 nrel := cons(k, nrel) 856 nrel := reverse!(nrel) 857 nrel := cons(i, nrel) 858 res := cons(nrel, res) 859 res 860 861 coerce(gp : %) : L PERM S == gp.gens 862 generators(gp : %) : L PERM S == gp.gens 863 864 strongGenerators(group) == 865 knownGroup? group 866 gr_supp := group.information.mp 867 gr_sgs := group.information.sgset 868 degree := # gr_supp 869 strongGens := []$(L PERM S) 870 for i in gr_sgs repeat 871 pairs := []$(L L S) 872 for j in 1..degree repeat 873 pairs := cons([ gr_supp.j, gr_supp.(i.j)], pairs) 874 strongGens := cons(coerceListOfPairs pairs, strongGens) 875 reverse strongGens 876 877 elt(gp, i) == (gp.gens).i 878 879 movedPoints(gp) == set(pointList(gp)) 880 881 random(group, maximalNumberOfFactors) == 882 maximalNumberOfFactors < 1 => 1$(PERM S) 883 gp : L PERM S := group.gens 884 numberOfGenerators := # gp 885 randomInteger : I := 1 + random(numberOfGenerators)$Integer 886 randomElement := gp.randomInteger 887 numberOfLoops : I := 1 + random(maximalNumberOfFactors)$Integer 888 while numberOfLoops > 0 repeat 889 randomInteger : I := 1 + random(numberOfGenerators)$Integer 890 randomElement := gp.randomInteger * randomElement 891 numberOfLoops := numberOfLoops - 1 892 randomElement 893 894 random(group) == random(group, 20) 895 896 order(group) == 897 knownGroup? group 898 group.information.order 899 900 degree(group) == # pointList group 901 902 base(group) == 903 knownGroup? group 904 gr_base := group.information.gpbase 905 gr_supp := group.information.mp 906 groupBase := []$(L S) 907 for i in gr_base repeat 908 groupBase := cons(gr_supp.i, groupBase) 909 reverse groupBase 910 911 wordsForStrongGenerators(group) == 912 gi := group.information 913 if #(gi.wd) = 0 then 914 initializeGroupForWordProblem(group) 915 gi := group.information 916 gi.wd 917 918 coerce (gp : L PERM S) : % == 919 result : REC2 := [0, [], [], [], [], []] 920 group := [gp, result] 921 922 permutationGroup (gp : L PERM S) : % == 923 result : REC2 := [0, [], [], [], [], []] 924 group := [gp, result] 925 926 coerce(group : %) : OUT == 927 outList := []$(L OUT) 928 gp : L PERM S := group.gens 929 for i in (maxIndex gp)..1 by -1 repeat 930 outList := cons(coerce gp.i, outList) 931 postfix(outputForm(">"::SYM), 932 postfix(commaSeparate outList, outputForm("<"::SYM))) 933 934 orbit(gp : %, el : S) : FSET S == 935 elList : L S := [el] 936 outList := orbitInternal(gp, elList) 937 outSet := empty()$(FSET S) 938 for i in 1..#outList repeat 939 insert!(outList.i.1, outSet ) 940 outSet 941 942 orbits(gp) == 943 spp := movedPoints(gp) 944 orbits := []$(L FSET S) 945 while cardinality spp > 0 repeat 946 el := extract! spp 947 orbitSet := orbit(gp, el) 948 orbits := cons(orbitSet, orbits) 949 spp := difference(spp, orbitSet) 950 set(orbits) 951 952 member? (p, gp) == 953 mi := memberInternal(p, gp, false) 954 mi.bool 955 956 wordInStrongGenerators (p, gp) == 957 mi := memberInternal(inv p, gp, true) 958 not mi.bool => error "p is not an element of gp" 959 mi.lst 960 961 wordInGenerators(p, gp) == 962 gp_info := gp.information 963 if #(gp_info.wd) = 0 then 964 initializeGroupForWordProblem gp 965 gp_info := gp.information 966 lll : L NNI := wordInStrongGenerators(p, gp) 967 outlist := []$(L NNI) 968 words := gp.information.wd 969 for n in lll repeat 970 outlist := append (outlist, words(n)) 971 shortenWord(outlist, gp) 972 973 gp1 < gp2 == 974 not empty? difference(movedPoints gp1, movedPoints gp2) => false 975 not subgroup(gp1, gp2) => false 976 order(gp1) = order(gp2) => false 977 true 978 979 gp1 <= gp2 == 980 not empty? difference(movedPoints gp1, movedPoints gp2) => false 981 subgroup(gp1, gp2) 982 983 gp1 = gp2 == 984 movedPoints gp1 ~= movedPoints gp2 => false 985 if #(gp1.gens) <= #(gp2.gens) then 986 not subgroup(gp1, gp2) => return false 987 else 988 not subgroup(gp2, gp1) => return false 989 order(gp1) = order(gp2) => true 990 false 991 992 orbit(gp : %, startSet : FSET S) : FSET FSET S == 993 startList : L S := parts startSet 994 outList := orbitInternal (gp, startList) 995 outSet := empty()$(FSET FSET S) 996 for i in 1..#outList repeat 997 newSet : FSET S := set(outList.i) 998 insert!(newSet, outSet) 999 outSet 1000 1001 orbit(gp : %, startList : L S) : FSET L S == 1002 set(orbitInternal(gp, startList)) 1003 1004 initializeGroupForWordProblem(gp, maxLoops, diff) == 1005 bsgs(gp, true, maxLoops, diff) 1006 void 1007 1008 initializeGroupForWordProblem(gp) == 1009 initializeGroupForWordProblem(gp, 0, 1) 1010 1011)abbrev package PGE PermutationGroupExamples 1012++ Authors: M. Weller, G. Schneider, J. Grabmeier 1013++ Date Created: 20 February 1990 1014++ Basic Operations: 1015++ Related Constructors: 1016++ Also See: 1017++ AMS Classifications: 1018++ Keywords: 1019++ References: 1020++ J. Conway, R. Curtis, S. Norton, R. Parker, R. Wilson: 1021++ Atlas of Finite Groups, Oxford, Clarendon Press, 1987 1022++ Description: 1023++ PermutationGroupExamples provides permutation groups for 1024++ some classes of groups: symmetric, alternating, dihedral, cyclic, 1025++ direct products of cyclic, which are in fact the finite abelian groups 1026++ of symmetric groups called Young subgroups. 1027++ Furthermore, Rubik's group as permutation group of 48 integers and a list 1028++ of sporadic simple groups derived from the atlas of finite groups. 1029 1030PermutationGroupExamples() : public == private where 1031 1032 L ==> List 1033 I ==> Integer 1034 PI ==> PositiveInteger 1035 NNI ==> NonNegativeInteger 1036 PERM ==> Permutation 1037 PERMGRP ==> PermutationGroup 1038 1039 public ==> with 1040 1041 symmetricGroup : PI -> PERMGRP I 1042 ++ symmetricGroup(n) constructs the symmetric group {\em Sn} 1043 ++ acting on the integers 1, ..., n, generators are the 1044 ++ {\em n}-cycle {\em (1, ..., n)} and the 2-cycle {\em (1, 2)}. 1045 symmetricGroup : L I -> PERMGRP I 1046 ++ symmetricGroup(li) constructs the symmetric group acting on 1047 ++ the integers in the list {\em li}, generators are the 1048 ++ cycle given by {\em li} and the 2-cycle {\em (li.1, li.2)}. 1049 ++ Note: duplicates in the list will be removed. 1050 alternatingGroup : PI -> PERMGRP I 1051 ++ alternatingGroup(n) constructs the alternating group {\em An} 1052 ++ acting on the integers 1, ..., n, generators are in general the 1053 ++ {\em n-2}-cycle {\em (3, ..., n)} and the 3-cycle {\em (1, 2, 3)} 1054 ++ if n is odd and the product of the 2-cycle {\em (1, 2)} with 1055 ++ {\em n-2}-cycle {\em (3, ..., n)} and the 3-cycle {\em (1, 2, 3)} 1056 ++ if n is even. 1057 alternatingGroup : L I -> PERMGRP I 1058 ++ alternatingGroup(li) constructs the alternating group acting 1059 ++ on the integers in the list {\em li}, generators are in general the 1060 ++ {\em n-2}-cycle {\em (li.3, ..., li.n)} and the 3-cycle 1061 ++ {\em (li.1, li.2, li.3)}, if n is odd and 1062 ++ product of the 2-cycle {\em (li.1, li.2)} with 1063 ++ {\em n-2}-cycle {\em (li.3, ..., li.n)} and the 3-cycle 1064 ++ {\em (li.1, li.2, li.3)}, if n is even. 1065 ++ Note: duplicates in the list will be removed. 1066 abelianGroup : L PI -> PERMGRP I 1067 ++ abelianGroup([n1, ..., nk]) constructs the abelian group that 1068 ++ is the direct product of cyclic groups with order {\em ni}. 1069 cyclicGroup : PI -> PERMGRP I 1070 ++ cyclicGroup(n) constructs the cyclic group of order n acting 1071 ++ on the integers 1, ..., n. 1072 cyclicGroup : L I -> PERMGRP I 1073 ++ cyclicGroup([i1, ..., ik]) constructs the cyclic group of 1074 ++ order k acting on the integers {\em i1}, ..., {\em ik}. 1075 ++ Note: duplicates in the list will be removed. 1076 dihedralGroup : PI -> PERMGRP I 1077 ++ dihedralGroup(n) constructs the dihedral group of order 2n 1078 ++ acting on integers 1, ..., N. 1079 dihedralGroup : L I -> PERMGRP I 1080 ++ dihedralGroup([i1, ..., ik]) constructs the dihedral group of 1081 ++ order 2k acting on the integers out of {\em i1}, ..., {\em ik}. 1082 ++ Note: duplicates in the list will be removed. 1083 mathieu11 : L I -> PERMGRP I 1084 ++ mathieu11(li) constructs the mathieu group acting on the 11 1085 ++ integers given in the list {\em li}. 1086 ++ Note: duplicates in the list will be removed. 1087 ++ error, if {\em li} has less or more than 11 different entries. 1088 mathieu11 : () -> PERMGRP I 1089 ++ mathieu11 constructs the mathieu group acting on the 1090 ++ integers 1, ..., 11. 1091 mathieu12 : L I -> PERMGRP I 1092 ++ mathieu12(li) constructs the mathieu group acting on the 12 1093 ++ integers given in the list {\em li}. 1094 ++ Note: duplicates in the list will be removed 1095 ++ Error: if {\em li} has less or more than 12 different entries. 1096 mathieu12 : () -> PERMGRP I 1097 ++ mathieu12 constructs the mathieu group acting on the 1098 ++ integers 1, ..., 12. 1099 mathieu22 : L I -> PERMGRP I 1100 ++ mathieu22(li) constructs the mathieu group acting on the 22 1101 ++ integers given in the list {\em li}. 1102 ++ Note: duplicates in the list will be removed. 1103 ++ Error: if {\em li} has less or more than 22 different entries. 1104 mathieu22 : () -> PERMGRP I 1105 ++ mathieu22 constructs the mathieu group acting on the 1106 ++ integers 1, ..., 22. 1107 mathieu23 : L I -> PERMGRP I 1108 ++ mathieu23(li) constructs the mathieu group acting on the 23 1109 ++ integers given in the list {\em li}. 1110 ++ Note: duplicates in the list will be removed. 1111 ++ Error: if {\em li} has less or more than 23 different entries. 1112 mathieu23 : () -> PERMGRP I 1113 ++ mathieu23 constructs the mathieu group acting on the 1114 ++ integers 1, ..., 23. 1115 mathieu24 : L I -> PERMGRP I 1116 ++ mathieu24(li) constructs the mathieu group acting on the 24 1117 ++ integers given in the list {\em li}. 1118 ++ Note: duplicates in the list will be removed. 1119 ++ Error: if {\em li} has less or more than 24 different entries. 1120 mathieu24 : () -> PERMGRP I 1121 ++ mathieu24 constructs the mathieu group acting on the 1122 ++ integers 1, ..., 24. 1123 janko2 : L I -> PERMGRP I 1124 ++ janko2(li) constructs the janko group acting on the 100 1125 ++ integers given in the list {\em li}. 1126 ++ Note: duplicates in the list will be removed. 1127 ++ Error: if {\em li} has less or more than 100 different entries 1128 janko2 : () -> PERMGRP I 1129 ++ janko2 constructs the janko group acting on the 1130 ++ integers 1, ..., 100. 1131 rubiksGroup : () -> PERMGRP I 1132 ++ rubiksGroup constructs the permutation group representing 1133 ++ Rubic's Cube acting on integers {\em 10*i+j} for 1134 ++ {\em 1 <= i <= 6}, {\em 1 <= j <= 8}. 1135 ++ The faces of Rubik's Cube are labelled in the obvious way 1136 ++ Front, Right, Up, Down, Left, Back and numbered from 1 to 6 1137 ++ in this given ordering, the pieces on each face 1138 ++ (except the unmoveable center piece) are clockwise numbered 1139 ++ from 1 to 8 starting with the piece in the upper left 1140 ++ corner. The moves of the cube are represented as permutations 1141 ++ on these pieces, represented as a two digit 1142 ++ integer {\em ij} where i is the numer of theface (1 to 6) 1143 ++ and j is the number of the piece on this face. 1144 ++ The remaining ambiguities are resolved by looking 1145 ++ at the 6 generators, which represent a 90 degree turns of the 1146 ++ faces, or from the following pictorial description. 1147 ++ Permutation group representing Rubic's Cube acting on integers 1148 ++ 10*i+j for 1 <= i <= 6, 1 <= j <=8. 1149 ++ 1150 ++ \begin{verbatim} 1151 ++ Rubik's Cube: +-----+ +-- B where: marks Side # : 1152 ++ / U /|/ 1153 ++ / / | F(ront) <-> 1 1154 ++ L --> +-----+ R| R(ight) <-> 2 1155 ++ | | + U(p) <-> 3 1156 ++ | F | / D(own) <-> 4 1157 ++ | |/ L(eft) <-> 5 1158 ++ +-----+ B(ack) <-> 6 1159 ++ ^ 1160 ++ | 1161 ++ D 1162 ++ 1163 ++ The Cube's surface: 1164 ++ The pieces on each side 1165 ++ +---+ (except the unmoveable center 1166 ++ |567| piece) are clockwise numbered 1167 ++ |4U8| from 1 to 8 starting with the 1168 ++ |321| piece in the upper left 1169 ++ +---+---+---+ corner (see figure on the 1170 ++ |781|123|345| left). The moves of the cube 1171 ++ |6L2|8F4|2R6| are represented as 1172 ++ |543|765|187| permutations on these pieces. 1173 ++ +---+---+---+ Each of the pieces is 1174 ++ |123| represented as a two digit 1175 ++ |8D4| integer ij where i is the 1176 ++ |765| # of the side ( 1 to 6 for 1177 ++ +---+ F to B (see table above )) 1178 ++ |567| and j is the # of the piece. 1179 ++ |4B8| 1180 ++ |321| 1181 ++ +---+ 1182 ++ \end{verbatim} 1183 youngGroup : L I -> PERMGRP I 1184 ++ youngGroup([n1, ..., nk]) constructs the direct product of the 1185 ++ symmetric groups {\em Sn1}, ..., {\em Snk}. 1186 youngGroup : Partition -> PERMGRP I 1187 ++ youngGroup(lambda) constructs the direct product of the symmetric 1188 ++ groups given by the parts of the partition {\em lambda}. 1189 1190 private ==> add 1191 1192 -- import the permutation and permutation group domains: 1193 1194 import from PERM I 1195 import from PERMGRP I 1196 1197 -- import the needed map function: 1198 1199 import from ListFunctions2(L L I, PERM I) 1200 -- the internal functions: 1201 1202 llli2gp(l : L L L I) : PERMGRP I == 1203 --++ Converts an list of permutations each represented by a list 1204 --++ of cycles ( each of them represented as a list of Integers ) 1205 --++ to the permutation group generated by these permutations. 1206 (map(cycles, l))::PERMGRP I 1207 1208 li1n(n : I) : L I == 1209 --++ constructs the list of integers from 1 to n 1210 [i for i in 1..n] 1211 1212 -- definition of the exported functions: 1213 youngGroup(l : L I) : PERMGRP I == 1214 gens := []$(L L L I) 1215 element : I := 1 1216 for n in l | n > 1 repeat 1217 gens := cons(list [i for i in element..(element+n-1)], gens) 1218 if n >= 3 then gens := cons([[element, element+1]], gens) 1219 element := element+n 1220 llli2gp 1221 #gens = 0 => [[[1]]] 1222 gens 1223 1224 youngGroup(lambda : Partition) : PERMGRP I == 1225 youngGroup(convert(lambda)$Partition) 1226 1227 rubiksGroup() : PERMGRP I == 1228 -- each generator represents a 90 degree turn of the appropriate 1229 -- side. 1230 f : L L I := 1231 [[11, 13, 15, 17], [12, 14, 16, 18], [51, 31, 21, 41], [53, 33, 23, 43], [52, 32, 22, 42]] 1232 r : L L I := 1233 [[21, 23, 25, 27], [22, 24, 26, 28], [13, 37, 67, 43], [15, 31, 61, 45], [14, 38, 68, 44]] 1234 u : L L I := 1235 [[31, 33, 35, 37], [32, 34, 36, 38], [13, 51, 63, 25], [11, 57, 61, 23], [12, 58, 62, 24]] 1236 d : L L I := 1237 [[41, 43, 45, 47], [42, 44, 46, 48], [17, 21, 67, 55], [15, 27, 65, 53], [16, 28, 66, 54]] 1238 l : L L I := 1239 [[51, 53, 55, 57], [52, 54, 56, 58], [11, 41, 65, 35], [17, 47, 63, 33], [18, 48, 64, 34]] 1240 b : L L I := 1241 [[61, 63, 65, 67], [62, 64, 66, 68], [45, 25, 35, 55], [47, 27, 37, 57], [46, 26, 36, 56]] 1242 llli2gp [f, r, u, d, l, b] 1243 1244 mathieu11(l : L I) : PERMGRP I == 1245 -- permutations derived from the ATLAS 1246 l := removeDuplicates l 1247 #l ~= 11 => error "Exactly 11 integers for mathieu11 needed !" 1248 a : L L I := [[l.1, l.10], [l.2, l.8], [l.3, l.11], [l.5, l.7]] 1249 llli2gp [a, [[l.1, l.4, l.7, l.6], [l.2, l.11, l.10, l.9]]] 1250 1251 mathieu11() : PERMGRP I == mathieu11 li1n 11 1252 1253 mathieu12(l : L I) : PERMGRP I == 1254 -- permutations derived from the ATLAS 1255 l := removeDuplicates l 1256 #l ~= 12 => error "Exactly 12 integers for mathieu12 needed !" 1257 a : L L I := 1258 [[l.1, l.2, l.3, l.4, l.5, l.6, l.7, l.8, l.9, l.10, l.11]] 1259 llli2gp [a, [[l.1, l.6, l.5, l.8, l.3, l.7, l.4, l.2, l.9, l.10], [l.11, l.12]]] 1260 1261 mathieu12() : PERMGRP I == mathieu12 li1n 12 1262 1263 mathieu22(l : L I) : PERMGRP I == 1264 -- permutations derived from the ATLAS 1265 l := removeDuplicates l 1266 #l ~= 22 => error "Exactly 22 integers for mathieu22 needed !" 1267 a : L L I := [[l.1, l.2, l.4, l.8, l.16, l.9, l.18, l.13, l.3, l.6, l.12], _ 1268 [l.5, l.10, l.20, l.17, l.11, l.22, l.21, l.19, l.15, l.7, l.14]] 1269 b : L L I := [[l.1, l.2, l.6, l.18], [l.3, l.15], [l.5, l.8, l.21, l.13], _ 1270 [l.7, l.9, l.20, l.12], [l.10, l.16], [l.11, l.19, l.14, l.22]] 1271 llli2gp [a, b] 1272 1273 mathieu22() : PERMGRP I == mathieu22 li1n 22 1274 1275 mathieu23(l : L I) : PERMGRP I == 1276 -- permutations derived from the ATLAS 1277 l := removeDuplicates l 1278 #l ~= 23 => error "Exactly 23 integers for mathieu23 needed !" 1279 a : L L I := [[l.1, l.2, l.3, l.4, l.5, l.6, l.7, l.8, l.9, l.10, l.11, l.12, l.13, l.14, _ 1280 l.15, l.16, l.17, l.18, l.19, l.20, l.21, l.22, l.23]] 1281 b : L L I := [[l.2, l.16, l.9, l.6, l.8], [l.3, l.12, l.13, l.18, l.4], _ 1282 [l.7, l.17, l.10, l.11, l.22], [l.14, l.19, l.21, l.20, l.15]] 1283 llli2gp [a, b] 1284 1285 mathieu23() : PERMGRP I == mathieu23 li1n 23 1286 1287 mathieu24(l : L I) : PERMGRP I == 1288 -- permutations derived from the ATLAS 1289 l := removeDuplicates l 1290 #l ~= 24 => error "Exactly 24 integers for mathieu24 needed !" 1291 a : L L I := [[l.1, l.16, l.10, l.22, l.24], [l.2, l.12, l.18, l.21, l.7], _ 1292 [l.4, l.5, l.8, l.6, l.17], [l.9, l.11, l.13, l.19, l.15]] 1293 b : L L I := [[l.1, l.22, l.13, l.14, l.6, l.20, l.3, l.21, l.8, l.11], [l.2, l.10], _ 1294 [l.4, l.15, l.18, l.17, l.16, l.5, l.9, l.19, l.12, l.7], [l.23, l.24]] 1295 llli2gp [a, b] 1296 1297 mathieu24() : PERMGRP I == mathieu24 li1n 24 1298 1299 janko2(l : L I) : PERMGRP I == 1300 -- permutations derived from the ATLAS 1301 l := removeDuplicates l 1302 #l ~= 100 => error "Exactly 100 integers for janko2 needed !" 1303 a : L L I := [ _ 1304 [l.2, l.3, l.4, l.5, l.6, l.7, l.8], _ 1305 [l.9, l.10, l.11, l.12, l.13, l.14, l.15], _ 1306 [l.16, l.17, l.18, l.19, l.20, l.21, l.22], _ 1307 [l.23, l.24, l.25, l.26, l.27, l.28, l.29], _ 1308 [l.30, l.31, l.32, l.33, l.34, l.35, l.36], _ 1309 [l.37, l.38, l.39, l.40, l.41, l.42, l.43], _ 1310 [l.44, l.45, l.46, l.47, l.48, l.49, l.50], _ 1311 [l.51, l.52, l.53, l.54, l.55, l.56, l.57], _ 1312 [l.58, l.59, l.60, l.61, l.62, l.63, l.64], _ 1313 [l.65, l.66, l.67, l.68, l.69, l.70, l.71], _ 1314 [l.72, l.73, l.74, l.75, l.76, l.77, l.78], _ 1315 [l.79, l.80, l.81, l.82, l.83, l.84, l.85], _ 1316 [l.86, l.87, l.88, l.89, l.90, l.91, l.92], _ 1317 [l.93, l.94, l.95, l.96, l.97, l.98, l.99] ] 1318 b : L L I := [ 1319 [l.1, l.74, l.83, l.21, l.36, l.77, l.44, l.80, l.64, l.2, l.34, l.75, l.48, l.17, l.100], _ 1320 [l.3, l.15, l.31, l.52, l.19, l.11, l.73, l.79, l.26, l.56, l.41, l.99, l.39, l.84, l.90], _ 1321 [l.4, l.57, l.86, l.63, l.85, l.95, l.82, l.97, l.98, l.81, l.8, l.69, l.38, l.43, l.58], _ 1322 [l.5, l.66, l.49, l.59, l.61], _ 1323 [l.6, l.68, l.89, l.94, l.92, l.20, l.13, l.54, l.24, l.51, l.87, l.27, l.76, l.23, l.67], _ 1324 [l.7, l.72, l.22, l.35, l.30, l.70, l.47, l.62, l.45, l.46, l.40, l.28, l.65, l.93, l.42], _ 1325 [l.9, l.71, l.37, l.91, l.18, l.55, l.96, l.60, l.16, l.53, l.50, l.25, l.32, l.14, l.33], _ 1326 [l.10, l.78, l.88, l.29, l.12] ] 1327 llli2gp [a, b] 1328 1329 janko2() : PERMGRP I == janko2 li1n 100 1330 1331 abelianGroup(l : L PI) : PERMGRP I == 1332 gens := []$(L L L I) 1333 element : I := 1 1334 for n in l | n > 1 repeat 1335 gens := cons( list [i for i in element..(element+n-1) ], gens ) 1336 element := element+n 1337 llli2gp 1338 #gens = 0 => [[[1]]] 1339 gens 1340 1341 alternatingGroup(l : L I) : PERMGRP I == 1342 l := removeDuplicates l 1343 #l = 0 => 1344 error "Cannot construct alternating group on empty set" 1345 #l < 3 => llli2gp [[[l.1]]] 1346 #l = 3 => llli2gp [[[l.1, l.2, l.3]]] 1347 tmp := [l.i for i in 3..(#l)] 1348 gens : L L L I := [[tmp], [[l.1, l.2, l.3]]] 1349 odd?(#l) => llli2gp gens 1350 gens.1 := cons([l.1, l.2], gens.1) 1351 llli2gp gens 1352 1353 alternatingGroup(n : PI) : PERMGRP I == alternatingGroup li1n n 1354 1355 symmetricGroup(l : L I) : PERMGRP I == 1356 l := removeDuplicates l 1357 #l = 0 => error "Cannot construct symmetric group on empty set !" 1358 #l < 3 => llli2gp [[l]] 1359 llli2gp [[l], [[l.1, l.2]]] 1360 1361 symmetricGroup(n : PI) : PERMGRP I == symmetricGroup li1n n 1362 1363 cyclicGroup(l : L I) : PERMGRP I == 1364 l := removeDuplicates l 1365 #l = 0 => error "Cannot construct cyclic group on empty set" 1366 llli2gp [[l]] 1367 1368 cyclicGroup(n : PI) : PERMGRP I == cyclicGroup li1n n 1369 1370 dihedralGroup(l : L I) : PERMGRP I == 1371 l := removeDuplicates l 1372 #l < 3 => error "in dihedralGroup: Minimum of 3 elements needed !" 1373 tmp := [[l.i, l.(#l-i+1) ] for i in 1..(#l quo 2)] 1374 llli2gp [ [ l ], tmp ] 1375 1376 dihedralGroup(n : PI) : PERMGRP I == 1377 n = 1 => symmetricGroup (2::PI) 1378 n = 2 => llli2gp [[[1, 2]], [[3, 4]]] 1379 dihedralGroup li1n n 1380 1381--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 1382--All rights reserved. 1383-- 1384--Redistribution and use in source and binary forms, with or without 1385--modification, are permitted provided that the following conditions are 1386--met: 1387-- 1388-- - Redistributions of source code must retain the above copyright 1389-- notice, this list of conditions and the following disclaimer. 1390-- 1391-- - Redistributions in binary form must reproduce the above copyright 1392-- notice, this list of conditions and the following disclaimer in 1393-- the documentation and/or other materials provided with the 1394-- distribution. 1395-- 1396-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 1397-- names of its contributors may be used to endorse or promote products 1398-- derived from this software without specific prior written permission. 1399-- 1400--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 1401--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 1402--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 1403--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 1404--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 1405--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 1406--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 1407--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 1408--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 1409--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 1410--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 1411