)abbrev domain PERMGRP PermutationGroup
++ Authors: G. Schneider, H. Gollan, J. Grabmeier
++ Date Created: 13 February 1987
++ Basic Operations:
++ Related Constructors: PermutationGroupExamples, Permutation
++ Also See: RepresentationTheoryPackage1
++ AMS Classifications:
++ Keywords: permutation, permutation group, group operation, word problem
++ References:
++   C. Sims: Determining the conjugacy classes of a permutation group,
++   in Computers in Algebra and Number Theory, SIAM-AMS Proc., Vol. 4,
++    Amer. Math. Soc., Providence, R. I., 1971, pp. 191-195
++ Description:
++  PermutationGroup implements permutation groups acting
++  on a set S, i.e. all subgroups of the symmetric group of S,
++  represented as a list of permutations (generators). Note that
++  therefore the objects are not members of the \Language category
++  \spadtype{Group}.
++  Using the idea of base and strong generators by Sims,
++  basic routines and algorithms
++  are implemented so that the word problem for
++  permutation groups can be solved.
--++  Note: we plan to implement lattice operations on the subgroup
--++  lattice in a later release

PermutationGroup(S : SetCategory) : public == private where

  L    ==> List
  PERM ==> Permutation
  FSET ==> Set
  I    ==> Integer
  NNI  ==> NonNegativeInteger
  V    ==> Vector
  B    ==> Boolean
  OUT   ==> OutputForm
  SYM  ==> Symbol
  REC  ==> Record ( orb : L NNI, svc : V I )
  REC2 ==> Record(order : NNI, sgset : L V NNI, _
             gpbase : L NNI, orbs : V REC, mp : L S, wd : L L NNI)
  REC3 ==> Record(elt : V NNI, lst : L NNI)
  REC4 ==> Record(bool : B, lst : L NNI)

  public ==> SetCategory with

    coerce           : %         -> L PERM S
      ++ coerce(gp) returns the generators of the group {\em gp}.
    generators           : %         -> L PERM S
      ++ generators(gp) returns the generators of the group {\em gp}.
    elt              : (%, NNI)   -> PERM S
      ++ elt(gp, i) returns the i-th generator of the group {\em gp}.
    random           : (%, I)     -> PERM S
      ++ random(gp, i) returns a random product of maximal i generators
      ++ of the group {\em gp}.
    random           : %         -> PERM S
      ++ random(gp) returns a random product of maximal 20 generators
      ++ of the group {\em gp}.
      ++ Note: {\em random(gp)=random(gp, 20)}.
    order            : %         -> NNI
      ++ order(gp) returns the order of the group {\em gp}.
    degree           : %         -> NNI
      ++ degree(gp) returns the number of points moved by all permutations
      ++ of the group {\em gp}.
    base             : %         -> L S
      ++ base(gp) returns a base for the group {\em gp}.
    strongGenerators : %         -> L PERM S
      ++ strongGenerators(gp) returns strong generators for
      ++ the group {\em gp}.
    wordsForStrongGenerators      : %         -> L L NNI
      ++ wordsForStrongGenerators(gp) returns the words for the strong
      ++ generators of the group {\em gp} in the original generators of
      ++ {\em gp}, represented by their indices in the list, given by
      ++ {\em generators}.
    coerce           : L PERM S  -> %
      ++ coerce(ls) coerces a list of permutations {\em ls} to the group
      ++ generated by this list.
    permutationGroup          : L PERM S  -> %
      ++ permutationGroup(ls) coerces a list of permutations {\em ls} to
      ++ the group generated by this list.
    orbit            : (%, S)     -> FSET S
      ++ orbit(gp, el) returns the orbit of the element {\em el} under the
      ++ group {\em gp}, i.e. the set of all points gained by applying
      ++ each group element to {\em el}.
    orbits           : %         -> FSET FSET S
      ++ orbits(gp) returns the orbits of the group {\em gp}, i.e.
      ++ it partitions the (finite) of all moved points.
    orbit            : (%, FSET S)-> FSET FSET S
      ++ orbit(gp, els) returns the orbit of the unordered
      ++ set {\em els} under the group {\em gp}.
    orbit            : (%, L S)   -> FSET L S
      ++ orbit(gp, ls) returns the orbit of the ordered
      ++ list {\em ls} under the group {\em gp}.
      ++ Note: return type is L L S temporarily because FSET L S has an error.
      -- (GILT DAS NOCH?)
    member?          : (PERM S, %)-> B
      ++ member?(pp, gp) answers the question, whether the
      ++ permutation {\em pp} is in the group {\em gp} or not.
    wordInStrongGenerators : (PERM S, %)-> L NNI
      ++ wordInStrongGenerators(p, gp) returns the word for the
      ++ permutation p in the strong generators of the group {\em gp},
      ++ represented by the indices of the list, given by
      ++ {\em strongGenerators}.
    wordInGenerators : (PERM S, %)-> L NNI
      ++ wordInGenerators(p, gp) returns the word for the permutation p
      ++ in the original generators of the group {\em gp},
      ++ represented by the indices of the list, given by {\em generators}.
    movedPoints      : %         -> FSET S
      ++ movedPoints(gp) returns the points moved by the group {\em gp}.
    "<"              : (%,%)     -> B
      ++ gp1 < gp2 returns true if and only if {\em gp1}
      ++ is a proper subgroup of {\em gp2}.
    "<="             : (%,%)     -> B
      ++ gp1 <= gp2 returns true if and only if {\em gp1}
      ++ is a subgroup of {\em gp2}.
      ++ Note: because of a bug in the parser you have to call this
      ++ function explicitly by {\em gp1 <=$(PERMGRP S) gp2}.
      -- (GILT DAS NOCH?)
    initializeGroupForWordProblem : %   -> Void
      ++ initializeGroupForWordProblem(gp) initializes the group {\em gp}
      ++ for the word problem.
      ++ Notes: it calls the other function of this name with parameters
      ++ 0 and 1: {\em initializeGroupForWordProblem(gp, 0, 1)}.
      ++ Notes: (1) be careful: invoking this routine will destroy the
      ++ possibly information about your group (but will recompute it again)
      ++ (2) users need not call this function normally for the soultion of
      ++ the word problem.
    initializeGroupForWordProblem : (%, I, I) -> Void
      ++ initializeGroupForWordProblem(gp, m, n) initializes the group
      ++ {\em gp} for the word problem.
      ++ Notes: (1) with a small integer you get shorter words, but the
      ++ routine takes longer than the standard routine for longer words.
      ++ (2) be careful: invoking this routine will destroy the possibly stored
      ++ information about your group (but will recompute it again).
      ++ (3) users need not call this function normally for the soultion of
      ++ the word problem.
    relationsInStrongGenerators : % -> L(L(I))
      ++ relationsInStrongGenerators(gp) computes relations between
      ++ strong generators.
    relationsInGenerators : % -> L(L(I))
      ++ relationsInGenerators(gp) computes relations between
      ++ generators.
    pointList : % -> L S
      ++ pointList(gp) should be local but conditional
    perm_to_vec : (L S, PERM S, NNI) -> V NNI
      ++ perm_to_vec(supp, p, degree) should be local but conditional
  private ==> add

    -- representation of the object:

    Rep  := Record(gens : L PERM S, information : REC2)

    -- import of domains and packages

    import from Permutation S
    import from OutputForm
    import from Symbol
    import from Void

  --local functions first, signatures:

    shortenWord : (L NNI, %)->L NNI
    times : (V NNI, V NNI)->V NNI
    orbitInternal : (%, L S )->L L S
    inv : V NNI->V NNI
    ranelt : (L V NNI, L L NNI, I)->REC3
    testIdentity : V NNI->B
    orbitWithSvc : (L V NNI, NNI )->REC
    bsgs1 : (L V NNI, NNI, L L NNI, I, %, I)->NNI
    initialize : %->FSET PERM S
    knownGroup? : %->Void
    subgroup : (%, %)->B
    memberInternal : (PERM S, %, B)->REC4

  --local functions first, implementations:

    shortenWord ( lw : L NNI, gp : % ) : L NNI ==
        -- tries to shorten a word in the generators by removing identities
        gpgens : L PERM S := coerce gp
        orderList : L NNI := [ order gen for gen in gpgens ]
        newlw : L NNI := copy lw
        for i in 1.. maxIndex orderList repeat
            if orderList.i = 1 then
                while member?(i, newlw) repeat
                    -- removing the trivial element
                    pos := position(i, newlw)
                    newlw := delete(newlw, pos)
        #newlw < 2 => newlw
        test := first(newlw)
        anzahl : NNI := 0
        flag1 : B := true
        do_res : B := false
        res : L NNI
        while flag1 repeat
            test := first(newlw)
            anzahl := 1
            if do_res then res := [test]
            flag2 : B := true
            for el in newlw while flag2 repeat
                if do_res then res := cons(el, res)
                anzahl := anzahl + 1
                anzahl = 1 => test := el
                test ~= el =>
                    test := el
                    anzahl := 1
                anzahl = orderList.test =>
                    if do_res then
                        res := rest(res, anzahl)
                    else
                        flag2 := false
                    anzahl := 0
            if do_res then
                newlw := reverse!(res)
            flag1 := do_res
            do_res := not(flag2)
        newlw

    -- internal multiplication of permutations
    times!(res : V NNI, p : V NNI, q : V NNI) : Void ==
        degree := #p
        for i in 1..degree repeat
            qsetelt!(res, i, qelt(p, qelt(q, i)))

    times ( p : V NNI, q : V NNI ) : V NNI ==
        degree := #p
        res : V NNI := new(degree, 0)
        times!(res, p, q)
        res

    -- internal inverse of a permutation
    inv ( p : V NNI ) : V NNI ==
        degree := #p
        q : V NNI := new(degree, 0)$(V NNI)
        for i in 1..degree repeat qsetelt!(q, (qelt(p, i)), i)
        q

    -- internal test for identity
    testIdentity ( p : V NNI ) : B ==
        degree := #p
        for i in 1..degree repeat qelt(p, i) ~= i => return false
        true

    cosetRep1(ppt : NNI, do_words : Boolean, o : REC, grpv : V V NNI,
              wordv : V L NNI) : REC3 ==
        #grpv = 0 => error "cosetRep needs nonempty group"
        degree := #(grpv(1))
        xelt : V NNI := [ n for n in 1..degree ]
        word         := []$(L NNI)
        osvc         := o.svc
        p := qelt(osvc, ppt)
        p < 0 => return [xelt, word]
        tmpv : V NNI := new(degree, 0)
        repeat
            x    := qelt(grpv, p)
            times!(tmpv, x, xelt)
            (tmpv, xelt) := (xelt, tmpv)
            if do_words then word := append(wordv.p, word)
            ppt  := qelt(x, ppt)
            p := qelt(osvc, ppt)
            p < 0 => return [xelt, word]

    strip1(element : V NNI, orbit : REC, group : L V NNI, words : L L NNI
          ) : REC3 ==
        grpv := vector(group)$Vector(V NNI)
        wordv : V L NNI := empty()
        do_words := not(empty?(words))
        if do_words then
            wordv := vector(words)
        point := qelt(element, qelt(orbit.orb, 1))
        cr := cosetRep1(point, do_words, orbit, grpv, wordv)
        [times(cr.elt, element), reverse(cr.lst)]$REC3

    strip(z : V NNI, i : I, do_words : Boolean,
            orbs : V REC, grpv : V V NNI, wordv : V L NNI) : REC3 ==
        degree := #z
        word := []$(L NNI)
        tmpv : V NNI := new(degree, 0)
        noresult : Boolean := true
        for j in i..1 by -1 while noresult repeat
            orbj := qelt(orbs, j)
            s := orbj.svc
            p := first(orbj.orb)
            while noresult repeat
                entry := qelt(s, qelt(z, p))
                if entry < 0 then
                    if entry = -1 then break
                    noresult := false
                else
                    ee := qelt(grpv, entry)
                    times!(tmpv, ee, z)
                    (z, tmpv) := (tmpv, z)
                    if do_words then word := append(wordv.entry, word)
        [z, word]

    orbitInternal(gp : %, startList : L S) : L L S ==
        orbitList : L L S := [ startList ]
        pos  : I := 1
        while not zero? pos  repeat
            gpset : L PERM S := gp.gens
            for gen in gpset repeat
                newList  := []$(L S)
                workList := orbitList.pos
                for j in #workList..1 by -1 repeat
                    newList := cons(eval(gen, workList.j), newList)
                if not member?( newList, orbitList ) then
                    orbitList := cons(newList, orbitList)
                    pos  := pos + 1
            pos := pos - 1
        reverse orbitList

    ranelt(group : L V NNI, word : L L NNI, maxLoops : I) : REC3 ==
        -- generate a "random" element
        numberOfGenerators    := # group
        randomInteger : I     := 1 + random(numberOfGenerators)$Integer
        randomElement : V NNI := group.randomInteger
        words                 := []$(L NNI)
        do_words : Boolean := not(empty?(word))
        if do_words then words := word.(randomInteger::NNI)
        if maxLoops > 0 then
            numberOfLoops : I  := 1 + random(maxLoops)$Integer
        else
            numberOfLoops : I := maxLoops
        while numberOfLoops > 0 repeat
            randomInteger : I := 1 + random(numberOfGenerators)$Integer
            randomElement := times(group.randomInteger, randomElement)
            if do_words then words := append(word.(randomInteger::NNI), words)
            numberOfLoops := numberOfLoops - 1
        [randomElement, words]

    if S has OrderedSet then
        pointList(group : %) : L S ==
            not(empty?(group.information.mp)) => group.information.mp
            support : L S := []
            for perm in group.gens repeat
                support := merge(sort((listRepresentation perm).preimage),
                                 support)
            res :  L S := []
            empty?(support) => res
            p0 := first(support)
            res := [p0]
            for p in rest(support) repeat
                p = p0 => iterate
                p0 := p
                res := cons(p, res)
            group.information.mp := reverse!(res)
    else
        pointList(group : %) : L S ==
            not(empty?(group.information.mp)) => group.information.mp
            support : FSET S := empty()
            for perm in group.gens repeat
                support := union(support, movedPoints perm)
            group.information.mp := parts support

    if S has OrderedSet then
        REC5 ==> Record(preimage : NNI, image : S)
        ls_to_lnni(ls : L S, supp : L S) : L NNI ==
            empty?(ls) => []
            ls2 := [[i, p]$REC5 for p in ls for i in 1..]
            ls2 := sort((x : REC5, y : REC5) : Boolean +->
                           x.image <= y.image,
                        ls2)
            pel := first(ls2)
            p1 := pel.image
            ls2 := rest(ls2)
            rp2 : L L NNI := []
            flag : Boolean := true
            for p2 in supp for i in 1.. while flag repeat
                if p1 = p2 then
                    rp2 := cons([pel.preimage, i], rp2)
                    empty?(ls2) => flag := false
                    pel := first(ls2)
                    p1 := pel.image
                    ls2 := rest(ls2)
            rp2 := sort((x : L NNI, y : L NNI) : Boolean +->
                           first(x) <= first(y),
                        rp2)
            [second(pp) for pp in rp2]

        perm_to_vec(supp : L S, p : PERM S, degree : NNI) : V NNI ==
            pr := listRepresentation p
            q := new(degree, 0)$(V NNI)
            for i in 1..degree repeat
                q(i) := i
            pl := ls_to_lnni(pr.preimage, supp)
            il := ls_to_lnni(pr.image, supp)
            for pp in pl for ip in il repeat
                q(pp) := ip
            q
    else
        perm_to_vec(supp : L S, p : PERM S, degree : NNI) : V NNI ==
            q := new(degree, 0)$(V NNI)
            for i in 1..degree repeat
                newEl := eval(p, supp.i)
                pos2  := position(newEl, supp)
                q.i   := qcoerce(pos2)
            q

    orbitWithSvc1(group : L V NNI, grpinv : L V NNI, point : NNI) : REC ==
        -- compute orbit with Schreier vector, "-2" means not in the orbit,
        -- "-1" means starting point, the PI correspond to generators
        degree := #(first(group))
        orbit          : L NNI := [ point ]
        orbitv         : V NNI := new(degree, 0)
        orbitv(1) := point
        orbit_size : NNI := 1
        schreierVector : V I   := new ( degree, -2 )
        schreierVector.point   := -1
        position : I := 1
        while not zero? position repeat
            for i in 1..#grpinv for grv in grpinv repeat
                newPoint := qelt(orbitv, orbit_size - position + 1)
                newPoint := qelt(grv, newPoint)
                if qelt(schreierVector, newPoint) = -2 then
                    orbit                   := cons ( newPoint, orbit )
                    orbit_size := orbit_size + 1
                    orbitv(orbit_size) := newPoint
                    position                := position + 1
                    schreierVector.newPoint := i
            position := position - 1
        [reverse!(orbit), schreierVector ]

    orbitWithSvc(group : L V NNI, point : NNI) : REC ==
        grpinv := []$(L V NNI)
        for el in group repeat
            grpinv := cons(inv el, grpinv)
        grpinv := reverse grpinv
        orbitWithSvc1(group, grpinv, point)

    bsgs1(group : L V NNI, number1 : NNI, words : L L NNI, maxLoops : I,
          gp : %, diff : I, out : Reference(L L V NNI),
          outword : Reference(L L L NNI)) : NNI ==
        -- try to get a good approximation for the strong generators and base
        degree := #(first(group))
        gp_info := gp.information
        wordProblem : Boolean := not(empty?(words))
        -- i := find moved point
        for i in number1..degree repeat
            ort := orbitWithSvc(group, i)
            k   := ort.orb
            k1  := # k
            if k1 ~= 1 then break
        gpsgs := []$(L V NNI)
        words2 := []$(L L NNI)
        gplength : NNI := #group
        -- j := nontrivial element
        for jj in 1..gplength repeat if (group.jj).i ~= i then break
        for k in 1..gplength repeat
            el2 := group.k
            if el2.i ~= i then
                gpsgs := cons(el2, gpsgs)
                if wordProblem then words2 := cons(words.k, words2)
            else
                gpsgs := cons(times(group.jj, el2), gpsgs)
                if wordProblem then
                      words2 := cons(append(words.jj, words.k), words2)
        group2 := []$(L V NNI)
        words3 := []$(L L NNI)
        j : I  := 15
        while j > 0 repeat
            -- find generators for the stabilizer
            ran := ranelt(group, words, maxLoops)
            str := strip1(ran.elt, ort, group, words)
            el2 := str.elt
            if not testIdentity el2 then
                if not member?(el2, group2) then
                    group2 := cons ( el2, group2 )
                    if wordProblem then
                        help : L NNI := append(reverse str.lst, ran.lst)
                        help         := shortenWord(help, gp)
                        words3       := cons(help, words3)
                    j := j - 2
            j := j - 1
        -- this is for word length control
        if wordProblem then maxLoops    := maxLoops - diff
        if empty?(group2) or (maxLoops < 0) then
            gp_info.gpbase := [i]
            setref(out, [gpsgs])
            setref(outword, [words2])
            return k1
        k2 := bsgs1(group2, i + 1, words3, maxLoops, gp, diff,
                    out, outword)
        sizeOfGroup : NNI := k1 * k2
        setref(out, append(deref(out), [gpsgs]))
        setref(outword, append(deref(outword), [words2]))
        gp_info.gpbase := cons(i, gp_info.gpbase)
        sizeOfGroup

    reduceGenerators(kkk : I, do_words : Boolean, gp_info : REC2,
                     outl : L L V NNI, outword : L L L NNI) : L V NNI ==
        -- try to reduce number of strong generators
        base_lst := gp_info.gpbase
        orbv := gp_info.orbs
        sgs : L V NNI := []
        res : L V NNI := []
        grpinv := []$(L V NNI)
        for i in 1..kkk repeat
            sgs := append(sgs, outl(i))
            grpinv := append(grpinv, map(inv, outl(i)))
        baseLength : NNI := #base_lst
        pt  := baseLength - kkk + 1
        obs := orbitWithSvc1(sgs, grpinv, base_lst(pt))
        orbv(kkk) := obs
        obs_len := # obs.orb
        if obs_len = 1 then
            outl(kkk) := []
        i   := 1
        outlk := outl(kkk)
        while not (i > # outlk) and # outlk > 1 repeat
            pos  := position(outlk(i), sgs)
            sgs2 := delete(sgs, pos)
            grpinv2 := delete(grpinv, pos)
            obs2 := orbitWithSvc1(sgs2, grpinv2, base_lst(pt))
            if # obs2.orb = obs_len then
                res := cons(outlk(i), res)
                sgs := sgs2
                grpinv := grpinv2
                outlk := delete(outlk, i)
                outl(kkk) := outlk
                orbv(kkk) := obs2
                if do_words then _
                    outword(kkk) := delete(outword(kkk), i)
             else
                i := i + 1
        res


    bsgs(group : %, wordProblem : Boolean, maxLoops : I, diff : I) : NNI ==
        -- the MOST IMPORTANT part of the package
        basePoint    : NNI           := 0
        newBasePoint : B := false
        baseOfGroup  : L NNI         := []
        out               : L L V NNI     := []
        outword           : L L L NNI     := []
        outr              : Reference(L L V NNI) := ref([])
        outwordr          : Reference(L L L NNI) := ref([])
        supp   := pointList group
        degree := # supp
        gp_info := [1, [], [], [], [], []]$REC2
        if degree = 0 then
            group.information := gp_info
            return 1
        newGroup := []$(L V NNI)
        gp       : L PERM S := group.gens
        words := []$(L L NNI)
        for ggg in 1..#gp for ggp in gp repeat
            q := perm_to_vec(supp, ggp, degree)
            newGroup := cons(q, newGroup )
            if wordProblem then words := cons(list ggg, words)
        if maxLoops < 1 then
            -- try to get the (approximate) base length
            if zero? (# ((group.information).gpbase)) then
                k := bsgs1(newGroup, 1, []$(L L NNI), 20, group, 0,
                                 outr, outwordr)
            maxLoops := #((group.information).gpbase) - 1
        bsgs1(newGroup, 1, words, maxLoops, group, diff, outr, outwordr)
        out := deref(outr)
        outword := deref(outwordr)
        kkk : I := 1
        newGroup := reverse newGroup
        noAnswer : B := true
        z : V NNI
        add_cnt : I := 0
        wordlist : L L NNI
        dummy_rec : REC := [[], empty()]
        baseOfGroup := (group.information).gpbase
        gp_info.gpbase := baseOfGroup
        orbv : V REC := new(# baseOfGroup, dummy_rec)$(V REC)
        while noAnswer repeat
            gp_info.gpbase := baseOfGroup
            gp_info.orbs := orbv
            -- test whether we have a base and a strong generating set
            sgs : L V NNI := []
            wordlist := []
            for i in 1..(kkk-1) repeat
                sgs := append(sgs, out.i)
                if wordProblem then wordlist := append (wordlist, outword.i)
            noresult : B := true
            z := new(degree, 0)
            for i in kkk..#baseOfGroup while noresult repeat
                rejects := reduceGenerators(i, wordProblem, gp_info,
                                            out, outword)
                sgs := append(sgs, out.i)
                sgsv := vector(sgs)$V(V NNI)
                wordv : V L NNI := empty()
                if wordProblem then
                    wordlist := append(wordlist, outword.i)
                    wordv := vector(wordlist)
                gporbi := orbv(i)
                for z0 in rejects while noresult repeat
                    z := copy(z0)
                    ppp := strip(z, i, false, orbv, sgsv, wordv)
                    noresult := testIdentity ppp.elt
                    if not(noresult) then
                        if wordProblem then
                            z := copy(z0)
                            ppp := strip(z, i, true, orbv, sgsv, wordv)
                        z := ppp.elt
                        word := ppp.lst
                for pt in gporbi.orb while noresult repeat
                    ppp   := cosetRep1(pt, wordProblem, gporbi, sgsv, wordv)
                    y1    := inv ppp.elt
                    word3 := ppp.lst
                    for jjj in 1..#sgs while noresult repeat
                        word         := []$(L NNI)
                        times!(z, qelt(sgsv, jjj), y1)
                        if wordProblem then word := qelt(wordv, jjj)
                        ppp := strip(z, i, false, orbv, sgsv, wordv)
                        z := ppp.elt
                        noresult := testIdentity z
                        if not(noresult) and wordProblem then
                            z := times (qelt(sgsv, jjj), y1)
                            ppp := strip(z, i, true, orbv, sgsv, wordv)
                            z := ppp.elt
                            word := append(ppp.lst, word)
                if not(noresult) then
                    for p in baseOfGroup for ii in 1.. repeat
                        basePoint    := 1
                        newBasePoint := true
                        if qelt(z, p) ~= p then
                            newBasePoint := false
                            basePoint    := (#baseOfGroup - ii + 1)::NNI
                            break
            noAnswer := not (testIdentity z)
            if noAnswer then
                add_cnt := add_cnt + 1
                -- we have missed something
                word2 := []$(L NNI)
                if wordProblem then
                    for wdi in word3 repeat
                        ttt := newGroup.wdi
                        while not (testIdentity ttt) repeat
                            word2 := cons(wdi, word2)
                            ttt   := times(ttt, newGroup.wdi)
                    word := append(word, word2)
                    word := shortenWord(word, group)
                if newBasePoint then
                    for i in 1..degree repeat
                        if z.i ~= i then
                            baseOfGroup := append(baseOfGroup, [ i ])
                            break
                    orbv := new(# baseOfGroup, dummy_rec)$(V REC)
                    out := cons(list  z, out)
                    if wordProblem then outword := cons(list word, outword)
                else
                    out.basePoint := cons(z, out.basePoint)
                    if wordProblem then
                        outword.basePoint := cons(word, outword.basePoint)
                kkk := basePoint
        sizeOfGroup : NNI := 1
        for j in 1..#baseOfGroup repeat
            sizeOfGroup := sizeOfGroup * # orbv(j).orb
        group.information := [sizeOfGroup, sgs, baseOfGroup, orbv, supp,
                              wordlist]$REC2
        sizeOfGroup


    initialize(group : %) : FSET PERM S ==
        group2 := empty()$(FSET PERM S)
        gp : L PERM S := group.gens
        for gen in gp repeat
            if degree gen > 0 then insert!(gen, group2)
        group2

    knownGroup?(gp : %) : Void ==
        -- do we know the group already?
        if gp.information.order = 0 then
            bsgs(gp, false, 20, 0)
        void

    subgroup(gp1 : %, gp2 : %) : B ==
        gpset1 := initialize gp1
        gpset2 := initialize gp2
        empty? difference(gpset1, gpset2) => true
        for el in parts gpset1 repeat
            not member?(el, gp2) => return false
        true

    memberInternal(p : PERM S, gp : %, do_words : B) : REC4 ==
        -- internal membership testing
        gr_supp     := pointList gp
        mP : L S := parts movedPoints p
        gp_info : REC2
        for x in mP repeat
            not member?(x, gr_supp) =>
                return [false, []$(L NNI)]
        if not(do_words) then
            member?(p, gp.gens) => return [true, []$(L NNI)]
        knownGroup? gp
        gp_info := gp.information
        sgsl := gp_info.sgset
        orbv := gp_info.orbs
        base_lst := gp_info.gpbase
        degree : NNI := #gr_supp

        pp := perm_to_vec(gr_supp, p, degree)

        wordv : V L NNI := empty()
        if do_words then
            wordv := new(#sgsl, [])
            for i in 1..#sgsl repeat
                wordv(i) := [i]
        grpv : V V NNI := vector(sgsl)
        str := strip(pp, #base_lst, do_words, orbv, grpv, wordv)
        [testIdentity str.elt, str.lst]

    orbit_words1(p0 : NNI, p : NNI, grp : L V NNI, acc : L NNI, res : V L NNI
                ) : Void ==
        for g in grp for i in 1.. repeat
            q := qelt(g, p)
            p0 = q => "skip"
            not(empty?(qelt(res, q))) => "skip"
            acc1 := cons(qcoerce(i)@NNI, acc)
            res(q) := acc1
            orbit_words1(p0, q, grp, acc1, res)

    orbit_words(p : NNI, grp : L V NNI) : V L NNI ==
        n := #first(grp)
        res := new(n, [])$(V L NNI)
        orbit_words1(p, p, grp, [], res)
        res

    relations_for_orbit(p : NNI, m : NNI, orbd : V REC,
                        grpv : V V NNI) : L L I ==
        -- print("relations_for_orbit"::OutputForm)
        -- print(p::OutputForm)
        res : L L I := []
        grpl := first(members(grpv), m)
        ww := orbit_words(p, grpl)
        -- print(ww::OutputForm)
        n0 := #(orbd(1).svc)
        wv := new(n0, empty()$Vector(NNI))$(V V NNI)
        wvi := new(n0, empty()$Vector(NNI))$(V V NNI)
        wordv := new(n0, empty())$(V L NNI)
        for i in 1..n0 repeat
            wordv(i) := [i]
            wi_l := qelt(ww, i)
            empty?(wi_l) => "skip"
            wi := new(n0, 0)$Vector(NNI)
            for j in 1..n0 repeat
                qsetelt!(wi, j, j)
            for j in reverse(wi_l) repeat
                times!(wi, qelt(grpv, j), wi)
            qsetelt!(wv, i, wi)
            qsetelt!(wvi, i, inv(wi))
        for i in 1..n0 repeat
            wi_l := qelt(ww, i)
            empty?(wi_l) => "skip"
            -- print("wi_l = "::OutputForm)
            -- print(wi_l::OutputForm)
            wi := qelt(wv, i)
            for j in 1..m repeat
                -- print("doing"::OutputForm)
                -- print(j::OutputForm)
                nw := times(grpv(j), wi)
                p1 := qelt(nw, p)
                iw : L NNI := []
                if p1 ~= p then
                    nw := times(wvi(p1), nw)
                    iw := ww(p1)
                cons(j, wi_l) = iw => "skip"
                nw := inv(nw)
                rhr := strip(nw, #orbd, true, orbd, grpv, wordv)
                rh := concat(iw, rhr.lst)
                -- print(rh::OutputForm)
                rl : L I := []
                for k in rh repeat
                    rl := cons(-k, rl)
                ll : L I := []
                for k in qelt(ww, i) repeat
                    ll := cons(k, ll)
                ll := reverse!(ll)
                rl := concat(ll, rl)
                rl := cons(j, rl)
                -- print(rl::OutputForm)
                res := cons(rl, res)
        res

    relations_in_strong_generators(orbd : V REC, grpv : V V NNI
                                  ) : L L I ==
        k := #orbd
        m := #grpv
        res : L L I := []
        bl : L NNI := []
        for i in 1..k repeat
            orbi := qelt(orbd, i)
            bl := cons(first(orbi.orb), bl)
        gri_l : L NNI := [m]
        blp := bl
        -- print(blp::OutputForm)
        p1 := first(blp)
        blp := rest(blp)
        for j in m..1 by -1 repeat
            gv := qelt(grpv, j)
            p2 := qelt(gv, p1)
            -- print(p2::OutputForm)
            if p1 = p2 then
                gri_l := cons(j, gri_l)
                empty?(blp) => break
                p1 := first(blp)
                blp := rest(blp)
        -- print(gri_l :: OutputForm)
        for p0 in reverse(bl) for m1 in gri_l repeat
            res := concat(relations_for_orbit(p0, m1, orbd, grpv), res)
        res

  --now the exported functions

    relationsInStrongGenerators(gp : %) : L(L(I)) ==
        knownGroup?(gp)
        gi := gp.information
        grpv := vector(gi.sgset)$V(V(NNI))
        relations_in_strong_generators(gi.orbs, grpv)

    relationsInGenerators(gp : %) : L(L(I)) ==
        gi := gp.information
        if #(gi.wd) = 0 then
            initializeGroupForWordProblem(gp)
            gi := gp.information
        grpv := vector(gi.sgset)$V(V(NNI))
        orbd := gi.orbs
        srels := relations_in_strong_generators(orbd, grpv)
        words := new(#(gi.wd), empty())$V(L(I))
        iwords := new(#words, empty())$V(L(I))
        for i in 1..#words for wli in gi.wd repeat
           words(i) := [j for j in wli]
           iwd := []$L(I)
           for j in wli repeat
               iwd := cons(-j, iwd)
           iwords(i) := iwd
        res : L(L(I)) := []
        for srel in srels repeat
            nrel : L(I) := []
            for i in srel repeat
                cw :=
                    i > 0 => qelt(words, i)
                    qelt(iwords, -i)
                for j in cw repeat
                    nrel := cons(j, nrel)
            res := cons(reverse!(nrel), res)
        supp := pointList(gp)
        nn := #supp
        n0 := #grpv
        wordv := new(n0, empty())$(V L NNI)
        for i in 1..n0 repeat
            wordv(i) := [i]
        for i in 1..#words for ggp in gp.gens repeat
            q := perm_to_vec(supp, ggp, nn)
            rhr := strip(q, #orbd, true, orbd, grpv, wordv)
            nrel : L(I) := []
            for j in rhr.lst repeat
                cw := words(j)
                for k in cw repeat
                    nrel := cons(k, nrel)
            nrel := reverse!(nrel)
            nrel := cons(i, nrel)
            res := cons(nrel, res)
        res

    coerce(gp : %) : L PERM S == gp.gens
    generators(gp : %) : L PERM S == gp.gens

    strongGenerators(group) ==
        knownGroup? group
        gr_supp := group.information.mp
        gr_sgs := group.information.sgset
        degree := # gr_supp
        strongGens := []$(L PERM S)
        for i in gr_sgs repeat
            pairs := []$(L L S)
            for j in 1..degree repeat
                pairs := cons([ gr_supp.j, gr_supp.(i.j)], pairs)
            strongGens := cons(coerceListOfPairs pairs, strongGens)
        reverse strongGens

    elt(gp, i) == (gp.gens).i

    movedPoints(gp) == set(pointList(gp))

    random(group, maximalNumberOfFactors) ==
        maximalNumberOfFactors < 1 => 1$(PERM S)
        gp : L PERM S := group.gens
        numberOfGenerators := # gp
        randomInteger : I  := 1 + random(numberOfGenerators)$Integer
        randomElement      := gp.randomInteger
        numberOfLoops : I  := 1 + random(maximalNumberOfFactors)$Integer
        while numberOfLoops > 0 repeat
            randomInteger : I  := 1 + random(numberOfGenerators)$Integer
            randomElement := gp.randomInteger * randomElement
            numberOfLoops := numberOfLoops - 1
        randomElement

    random(group) == random(group, 20)

    order(group) ==
        knownGroup? group
        group.information.order

    degree(group) == # pointList group

    base(group) ==
        knownGroup? group
        gr_base := group.information.gpbase
        gr_supp := group.information.mp
        groupBase := []$(L S)
        for i in gr_base repeat
            groupBase := cons(gr_supp.i, groupBase)
        reverse groupBase

    wordsForStrongGenerators(group) ==
        gi := group.information
        if #(gi.wd) = 0 then
            initializeGroupForWordProblem(group)
            gi := group.information
        gi.wd

    coerce (gp : L PERM S) : % ==
        result : REC2 := [0, [], [], [], [], []]
        group         := [gp, result]

    permutationGroup (gp : L PERM S) : % ==
        result : REC2 := [0, [], [], [], [], []]
        group         := [gp, result]

    coerce(group : %) : OUT ==
        outList := []$(L OUT)
        gp : L PERM S := group.gens
        for i in (maxIndex gp)..1 by -1 repeat
            outList := cons(coerce gp.i, outList)
        postfix(outputForm(">"::SYM),
                postfix(commaSeparate outList, outputForm("<"::SYM)))

    orbit(gp : %, el : S) : FSET S ==
        elList : L S := [el]
        outList      := orbitInternal(gp, elList)
        outSet       := empty()$(FSET S)
        for i in 1..#outList repeat
            insert!(outList.i.1, outSet )
        outSet

    orbits(gp) ==
        spp    := movedPoints(gp)
        orbits := []$(L FSET S)
        while cardinality spp > 0 repeat
            el       := extract! spp
            orbitSet := orbit(gp, el)
            orbits   := cons(orbitSet, orbits)
            spp      := difference(spp, orbitSet)
        set(orbits)

    member? (p, gp) ==
        mi := memberInternal(p, gp, false)
        mi.bool

    wordInStrongGenerators (p, gp) ==
        mi := memberInternal(inv p, gp, true)
        not mi.bool => error "p is not an element of gp"
        mi.lst

    wordInGenerators(p, gp) ==
        gp_info := gp.information
        if #(gp_info.wd) = 0 then
            initializeGroupForWordProblem gp
            gp_info := gp.information
        lll : L NNI := wordInStrongGenerators(p, gp)
        outlist := []$(L NNI)
        words := gp.information.wd
        for n in lll repeat
            outlist := append (outlist, words(n))
        shortenWord(outlist, gp)

    gp1 < gp2 ==
        not empty? difference(movedPoints gp1, movedPoints gp2) => false
        not subgroup(gp1, gp2) => false
        order(gp1) = order(gp2) => false
        true

    gp1 <= gp2 ==
        not empty? difference(movedPoints gp1, movedPoints gp2) => false
        subgroup(gp1, gp2)

    gp1 = gp2 ==
        movedPoints gp1 ~= movedPoints gp2 => false
        if #(gp1.gens) <= #(gp2.gens) then
            not subgroup(gp1, gp2) => return false
        else
            not subgroup(gp2, gp1) => return false
        order(gp1) = order(gp2) => true
        false

    orbit(gp : %, startSet : FSET S) : FSET FSET S ==
        startList : L S := parts startSet
        outList         := orbitInternal (gp, startList)
        outSet          := empty()$(FSET FSET S)
        for i in 1..#outList repeat
            newSet : FSET S := set(outList.i)
            insert!(newSet, outSet)
        outSet

    orbit(gp : %, startList : L S) : FSET L S ==
        set(orbitInternal(gp, startList))

    initializeGroupForWordProblem(gp, maxLoops, diff) ==
        bsgs(gp, true, maxLoops, diff)
        void

    initializeGroupForWordProblem(gp) ==
        initializeGroupForWordProblem(gp, 0, 1)

)abbrev package PGE PermutationGroupExamples
++ Authors: M. Weller, G. Schneider, J. Grabmeier
++ Date Created: 20 February 1990
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++  J. Conway, R. Curtis, S. Norton, R. Parker, R. Wilson:
++   Atlas of Finite Groups, Oxford, Clarendon Press, 1987
++ Description:
++   PermutationGroupExamples provides permutation groups for
++   some classes of groups: symmetric, alternating, dihedral, cyclic,
++   direct products of cyclic, which are in fact the finite abelian groups
++   of symmetric groups called Young subgroups.
++   Furthermore, Rubik's group as permutation group of 48 integers and a list
++   of sporadic simple groups derived from the atlas of finite groups.

PermutationGroupExamples() : public == private where

    L          ==> List
    I          ==> Integer
    PI         ==> PositiveInteger
    NNI        ==> NonNegativeInteger
    PERM       ==> Permutation
    PERMGRP   ==> PermutationGroup

    public ==> with

      symmetricGroup :       PI        -> PERMGRP I
        ++ symmetricGroup(n) constructs the symmetric group {\em Sn}
        ++ acting on the integers 1, ..., n, generators are the
        ++ {\em n}-cycle {\em (1, ..., n)} and the 2-cycle {\em (1, 2)}.
      symmetricGroup :       L I       -> PERMGRP I
        ++ symmetricGroup(li) constructs the symmetric group acting on
        ++ the integers in the list {\em li}, generators are the
        ++ cycle given by {\em li} and the 2-cycle {\em (li.1, li.2)}.
        ++ Note: duplicates in the list will be removed.
      alternatingGroup :     PI        -> PERMGRP I
        ++ alternatingGroup(n) constructs the alternating group {\em An}
        ++ acting on the integers 1, ..., n,  generators are in general the
        ++ {\em n-2}-cycle {\em (3, ..., n)} and the 3-cycle {\em (1, 2, 3)}
        ++ if n is odd and the product of the 2-cycle {\em (1, 2)} with
        ++ {\em n-2}-cycle {\em (3, ..., n)} and the 3-cycle {\em (1, 2, 3)}
        ++ if n is even.
      alternatingGroup :     L I       -> PERMGRP I
        ++ alternatingGroup(li) constructs the alternating group acting
        ++ on the integers in the list {\em li}, generators are in general the
        ++ {\em n-2}-cycle {\em (li.3, ..., li.n)} and the 3-cycle
        ++ {\em (li.1, li.2, li.3)}, if n is odd and
        ++ product of the 2-cycle {\em (li.1, li.2)} with
        ++ {\em n-2}-cycle {\em (li.3, ..., li.n)} and the 3-cycle
        ++ {\em (li.1, li.2, li.3)}, if n is even.
        ++ Note: duplicates in the list will be removed.
      abelianGroup :         L PI      -> PERMGRP I
        ++ abelianGroup([n1, ..., nk]) constructs the abelian group that
        ++ is the direct product of cyclic groups with order {\em ni}.
      cyclicGroup :          PI        -> PERMGRP I
        ++ cyclicGroup(n) constructs the cyclic group of order n acting
        ++ on the integers 1, ..., n.
      cyclicGroup :          L I       -> PERMGRP I
        ++ cyclicGroup([i1, ..., ik]) constructs the cyclic group of
        ++ order k acting on the integers {\em i1}, ..., {\em ik}.
        ++ Note: duplicates in the list will be removed.
      dihedralGroup :        PI        -> PERMGRP I
        ++ dihedralGroup(n) constructs the dihedral group of order 2n
        ++ acting on integers 1, ..., N.
      dihedralGroup :        L I       -> PERMGRP I
        ++ dihedralGroup([i1, ..., ik]) constructs the dihedral group of
        ++ order 2k acting on the integers out of {\em i1}, ..., {\em ik}.
        ++ Note: duplicates in the list will be removed.
      mathieu11 :            L I       -> PERMGRP I
        ++ mathieu11(li) constructs the mathieu group acting on the 11
        ++ integers given in the list {\em li}.
        ++ Note: duplicates in the list will be removed.
        ++ error, if {\em li} has less or more than 11 different entries.
      mathieu11 :            ()        -> PERMGRP I
        ++ mathieu11 constructs the mathieu group acting on the
        ++ integers 1, ..., 11.
      mathieu12 :            L I       -> PERMGRP I
        ++ mathieu12(li) constructs the mathieu group acting on the 12
        ++ integers given in the list {\em li}.
        ++ Note: duplicates in the list will be removed
        ++ Error: if {\em li} has less or more than 12 different entries.
      mathieu12 :            ()        -> PERMGRP I
        ++ mathieu12 constructs the mathieu group acting on the
        ++ integers 1, ..., 12.
      mathieu22 :            L I       -> PERMGRP I
        ++ mathieu22(li) constructs the mathieu group acting on the 22
        ++ integers given in the list {\em li}.
        ++ Note: duplicates in the list will be removed.
        ++ Error: if {\em li} has less or more than 22 different entries.
      mathieu22 :            ()        -> PERMGRP I
        ++ mathieu22 constructs the mathieu group acting on the
        ++ integers 1, ..., 22.
      mathieu23 :            L I       -> PERMGRP I
        ++ mathieu23(li) constructs the mathieu group acting on the 23
        ++ integers given in the list {\em li}.
        ++ Note: duplicates in the list will be removed.
        ++ Error: if {\em li} has less or more than 23 different entries.
      mathieu23 :            ()        -> PERMGRP I
        ++ mathieu23 constructs the mathieu group acting on the
        ++ integers 1, ..., 23.
      mathieu24 :            L I       -> PERMGRP I
        ++ mathieu24(li) constructs the mathieu group acting on the 24
        ++ integers given in the list {\em li}.
        ++ Note: duplicates in the list will be removed.
        ++ Error: if {\em li} has less or more than 24 different entries.
      mathieu24 :            ()        -> PERMGRP I
        ++ mathieu24 constructs the mathieu group acting on the
        ++ integers 1, ..., 24.
      janko2 :               L I       -> PERMGRP I
        ++ janko2(li) constructs the janko group acting on the 100
        ++ integers given in the list {\em li}.
        ++ Note: duplicates in the list will be removed.
        ++ Error: if {\em li} has less or more than 100 different entries
      janko2 :               ()        -> PERMGRP I
        ++ janko2 constructs the janko group acting on the
        ++ integers 1, ..., 100.
      rubiksGroup :          ()        -> PERMGRP I
        ++ rubiksGroup constructs the permutation group representing
        ++ Rubic's Cube acting on integers {\em 10*i+j} for
        ++ {\em 1 <= i <= 6}, {\em 1 <= j <= 8}.
        ++ The faces of Rubik's Cube are labelled in the obvious way
        ++ Front, Right, Up, Down, Left, Back and numbered from 1 to 6
        ++ in this given ordering, the pieces on each face
        ++ (except the unmoveable center piece) are clockwise numbered
        ++ from 1 to 8 starting with the piece in the upper left
        ++ corner. The moves of the cube are represented as permutations
        ++ on these pieces, represented as a two digit
        ++ integer {\em ij} where i is the numer of theface (1 to 6)
        ++ and j is the number of the piece on this face.
        ++ The remaining ambiguities are resolved by looking
        ++ at the 6 generators, which represent a 90 degree turns of the
        ++ faces, or from the following pictorial description.
        ++ Permutation group representing Rubic's Cube acting on integers
        ++ 10*i+j for 1 <= i <= 6, 1 <= j <=8.
        ++
        ++ \begin{verbatim}
        ++ Rubik's Cube:   +-----+ +-- B   where: marks Side # :
        ++                / U   /|/
        ++               /     / |         F(ront)    <->    1
        ++       L -->  +-----+ R|         R(ight)    <->    2
        ++              |     |  +         U(p)       <->    3
        ++              |  F  | /          D(own)     <->    4
        ++              |     |/           L(eft)     <->    5
        ++              +-----+            B(ack)     <->    6
        ++                 ^
        ++                 |
        ++                 D
        ++
        ++ The Cube's surface:
        ++                                The pieces on each side
        ++             +---+              (except the unmoveable center
        ++             |567|              piece) are clockwise numbered
        ++             |4U8|              from 1 to 8 starting with the
        ++             |321|              piece in the upper left
        ++         +---+---+---+          corner (see figure on the
        ++         |781|123|345|          left).  The moves of the cube
        ++         |6L2|8F4|2R6|          are represented as
        ++         |543|765|187|          permutations on these pieces.
        ++         +---+---+---+          Each of the pieces is
        ++             |123|              represented as a two digit
        ++             |8D4|              integer ij where i is the
        ++             |765|              # of the side ( 1 to 6 for
        ++             +---+              F to B (see table above ))
        ++             |567|              and j is the # of the piece.
        ++             |4B8|
        ++             |321|
        ++             +---+
        ++ \end{verbatim}
      youngGroup :           L I      -> PERMGRP I
        ++ youngGroup([n1, ..., nk]) constructs the direct product of the
        ++ symmetric groups {\em Sn1}, ..., {\em Snk}.
      youngGroup :    Partition        -> PERMGRP I
        ++ youngGroup(lambda) constructs the direct product of the symmetric
        ++ groups given by the parts of the partition {\em lambda}.

    private ==> add

      -- import the permutation and permutation group domains:

      import from PERM I
      import from PERMGRP I

      -- import the needed map function:

      import from ListFunctions2(L L I, PERM I)
      -- the internal functions:

      llli2gp(l : L L L I) : PERMGRP I ==
        --++ Converts an list of permutations each represented by a list
        --++ of cycles ( each of them represented as a list of Integers )
        --++ to the permutation group generated by these permutations.
        (map(cycles, l))::PERMGRP I

      li1n(n : I) : L I ==
        --++ constructs the list of integers from 1 to n
        [i for i in 1..n]

      -- definition of the exported functions:
      youngGroup(l : L I) : PERMGRP I ==
        gens := []$(L L L I)
        element : I := 1
        for n in l | n > 1 repeat
          gens := cons(list [i for i in element..(element+n-1)], gens)
          if n >= 3 then gens := cons([[element, element+1]], gens)
          element := element+n
        llli2gp
          #gens = 0 => [[[1]]]
          gens

      youngGroup(lambda : Partition) : PERMGRP I ==
        youngGroup(convert(lambda)$Partition)

      rubiksGroup() : PERMGRP I ==
        -- each generator represents a 90 degree turn of the appropriate
        -- side.
        f : L L I :=
         [[11, 13, 15, 17], [12, 14, 16, 18], [51, 31, 21, 41], [53, 33, 23, 43], [52, 32, 22, 42]]
        r : L L I :=
         [[21, 23, 25, 27], [22, 24, 26, 28], [13, 37, 67, 43], [15, 31, 61, 45], [14, 38, 68, 44]]
        u : L L I :=
         [[31, 33, 35, 37], [32, 34, 36, 38], [13, 51, 63, 25], [11, 57, 61, 23], [12, 58, 62, 24]]
        d : L L I :=
         [[41, 43, 45, 47], [42, 44, 46, 48], [17, 21, 67, 55], [15, 27, 65, 53], [16, 28, 66, 54]]
        l : L L I :=
         [[51, 53, 55, 57], [52, 54, 56, 58], [11, 41, 65, 35], [17, 47, 63, 33], [18, 48, 64, 34]]
        b : L L I :=
         [[61, 63, 65, 67], [62, 64, 66, 68], [45, 25, 35, 55], [47, 27, 37, 57], [46, 26, 36, 56]]
        llli2gp [f, r, u, d, l, b]

      mathieu11(l : L I) : PERMGRP I ==
      -- permutations derived from the ATLAS
        l := removeDuplicates l
        #l ~= 11 => error "Exactly 11 integers for mathieu11 needed !"
        a : L L I := [[l.1, l.10], [l.2, l.8], [l.3, l.11], [l.5, l.7]]
        llli2gp [a, [[l.1, l.4, l.7, l.6], [l.2, l.11, l.10, l.9]]]

      mathieu11() : PERMGRP I == mathieu11 li1n 11

      mathieu12(l : L I) : PERMGRP I ==
      -- permutations derived from the ATLAS
        l := removeDuplicates l
        #l ~= 12 => error "Exactly 12 integers for mathieu12 needed !"
        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]]
        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]]]

      mathieu12() : PERMGRP I == mathieu12 li1n 12

      mathieu22(l : L I) : PERMGRP I ==
      -- permutations derived from the ATLAS
        l := removeDuplicates l
        #l ~= 22 => error "Exactly 22 integers for mathieu22 needed !"
        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],   _
          [l.5, l.10, l.20, l.17, l.11, l.22, l.21, l.19, l.15, l.7, l.14]]
        b : L L I := [[l.1, l.2, l.6, l.18], [l.3, l.15], [l.5, l.8, l.21, l.13],   _
          [l.7, l.9, l.20, l.12], [l.10, l.16], [l.11, l.19, l.14, l.22]]
        llli2gp [a, b]

      mathieu22() : PERMGRP I == mathieu22 li1n 22

      mathieu23(l : L I) : PERMGRP I ==
      -- permutations derived from the ATLAS
        l := removeDuplicates l
        #l ~= 23 => error "Exactly 23 integers for mathieu23 needed !"
        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, _
                   l.15, l.16, l.17, l.18, l.19, l.20, l.21, l.22, l.23]]
        b : L L I := [[l.2, l.16, l.9, l.6, l.8], [l.3, l.12, l.13, l.18, l.4],              _
                   [l.7, l.17, l.10, l.11, l.22], [l.14, l.19, l.21, l.20, l.15]]
        llli2gp [a, b]

      mathieu23() : PERMGRP I == mathieu23 li1n 23

      mathieu24(l : L I) : PERMGRP I ==
      -- permutations derived from the ATLAS
        l := removeDuplicates l
        #l ~= 24 => error "Exactly 24 integers for mathieu24 needed !"
        a : L L I := [[l.1, l.16, l.10, l.22, l.24], [l.2, l.12, l.18, l.21, l.7],          _
                   [l.4, l.5, l.8, l.6, l.17], [l.9, l.11, l.13, l.19, l.15]]
        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],  _
                   [l.4, l.15, l.18, l.17, l.16, l.5, l.9, l.19, l.12, l.7], [l.23, l.24]]
        llli2gp [a, b]

      mathieu24() : PERMGRP I == mathieu24 li1n 24

      janko2(l : L I) : PERMGRP I ==
      -- permutations derived from the ATLAS
        l := removeDuplicates l
        #l ~= 100 => error "Exactly 100 integers for janko2 needed !"
        a : L L I := [                                                            _
                 [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, l.15],                         _
                 [l.16, l.17, l.18, l.19, l.20, l.21, l.22],                        _
                 [l.23, l.24, l.25, l.26, l.27, l.28, l.29],                        _
                 [l.30, l.31, l.32, l.33, l.34, l.35, l.36],                        _
                 [l.37, l.38, l.39, l.40, l.41, l.42, l.43],                        _
                 [l.44, l.45, l.46, l.47, l.48, l.49, l.50],                        _
                 [l.51, l.52, l.53, l.54, l.55, l.56, l.57],                        _
                 [l.58, l.59, l.60, l.61, l.62, l.63, l.64],                        _
                 [l.65, l.66, l.67, l.68, l.69, l.70, l.71],                        _
                 [l.72, l.73, l.74, l.75, l.76, l.77, l.78],                        _
                 [l.79, l.80, l.81, l.82, l.83, l.84, l.85],                        _
                 [l.86, l.87, l.88, l.89, l.90, l.91, l.92],                        _
                 [l.93, l.94, l.95, l.96, l.97, l.98, l.99] ]
        b : L L I := [
                [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], _
                [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], _
                [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], _
                [l.5, l.66, l.49, l.59, l.61], _
                [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], _
                [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], _
                [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], _
                [l.10, l.78, l.88, l.29, l.12] ]
        llli2gp [a, b]

      janko2() : PERMGRP I == janko2 li1n 100

      abelianGroup(l : L PI) : PERMGRP I ==
        gens := []$(L L L I)
        element : I := 1
        for n in l | n > 1 repeat
          gens := cons( list [i for i in element..(element+n-1) ], gens )
          element := element+n
        llli2gp
          #gens = 0 => [[[1]]]
          gens

      alternatingGroup(l : L I) : PERMGRP I ==
        l := removeDuplicates l
        #l = 0 =>
          error "Cannot construct alternating group on empty set"
        #l < 3 => llli2gp [[[l.1]]]
        #l = 3 => llli2gp [[[l.1, l.2, l.3]]]
        tmp := [l.i for i in 3..(#l)]
        gens : L L L I := [[tmp], [[l.1, l.2, l.3]]]
        odd?(#l) => llli2gp gens
        gens.1 := cons([l.1, l.2], gens.1)
        llli2gp gens

      alternatingGroup(n : PI) : PERMGRP I == alternatingGroup li1n n

      symmetricGroup(l : L I) : PERMGRP I ==
        l := removeDuplicates l
        #l = 0 => error "Cannot construct symmetric group on empty set !"
        #l < 3 => llli2gp [[l]]
        llli2gp [[l], [[l.1, l.2]]]

      symmetricGroup(n : PI) : PERMGRP I == symmetricGroup li1n n

      cyclicGroup(l : L I) : PERMGRP I ==
        l := removeDuplicates l
        #l = 0 => error "Cannot construct cyclic group on empty set"
        llli2gp [[l]]

      cyclicGroup(n : PI) : PERMGRP I == cyclicGroup li1n n

      dihedralGroup(l : L I) : PERMGRP I ==
        l := removeDuplicates l
        #l < 3 => error "in dihedralGroup: Minimum of 3 elements needed !"
        tmp := [[l.i, l.(#l-i+1) ] for i in 1..(#l quo 2)]
        llli2gp [ [ l ], tmp ]

      dihedralGroup(n : PI) : PERMGRP I ==
        n = 1 => symmetricGroup (2::PI)
        n = 2 => llli2gp [[[1, 2]], [[3, 4]]]
        dihedralGroup li1n n

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
