\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra permgrps.spad}
\author{Gerhard Schneider, Holger Gollan, Johannes Grabmeier, M. Weller}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{domain PERMGRP PermutationGroup}
<<domain PERMGRP PermutationGroup>>=
)abbrev domain PERMGRP PermutationGroup
++ Authors: G. Schneider, H. Gollan, J. Grabmeier
++ Date Created: 13 February 1987
++ Date Last Updated: 24 May 1991
++ 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.
    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 Permutation S
    import OutputForm
    import Symbol
    import 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         := nil()$(L NNI)
        oorb         := o.orb
        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 := nil()$(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  := nil()$(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                 := nil()$(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 :=  brace()   -- empty set !!
            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   := pos2 pretend NNI
            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 := nil()$(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 leave
      gpsgs := nil()$(L V NNI)
      words2 := nil()$(L L NNI)
      gplength : NNI := #group
      -- j := nontrivial element
      for jj in 1..gplength repeat if (group.jj).i ~= i then leave
      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 := nil()$(L V NNI)
      words3 := nil()$(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 ( null 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 := nil()
        res : L V NNI := nil()
        grpinv := nil()$(L V NNI)
        for i in 1..kkk repeat
            sgs := append(sgs, outl(i))
            grpinv := append(grpinv, map(inv, outl(i)))
        removedGenerator : Boolean := false
        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
            removedGenerator := true
            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 := nil()$(L V NNI)
      tmpv : V NNI := new(degree, 0)
      gp       : L PERM S := group.gens
      words := nil()$(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, nil()$(L L NNI), 20, group, 0,
                               outr, outwordr)
        maxLoops    := (# ((group.information).gpbase)) - 1
      k := 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 := nil()
        wordlist := nil()
        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         := nil()$(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 := nil()$(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 ] )
                leave
            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 := brace()$(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, nil()$(L NNI) ]
      if not(do_words) then
          member?(p, gp.gens) => return [true , nil()$(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]

  --now the exported functions

    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 := nil()$(L PERM S)
      for i in gr_sgs repeat
        pairs := nil()$(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 ) == brace 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 := nil()$(L S)
      for i in gr_base repeat
          groupBase := cons(gr_supp.i, groupBase)
      reverse groupBase

    wordsForStrongGenerators ( group ) ==
      knownGroup? group
      group.information.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 := nil()$(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       := brace()$(FSET S)
      for i in 1..#outList repeat
        insert_! ( outList.i.1 , outSet )
      outSet

    orbits ( gp ) ==
      spp    := movedPoints gp
      orbits := nil()$(L FSET S)
      while cardinality spp > 0 repeat
        el       := extract_! spp
        orbitSet := orbit ( gp , el )
        orbits   := cons ( orbitSet , orbits )
        spp      := difference ( spp , orbitSet )
      brace 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
        lll : L NNI := wordInStrongGenerators(p, gp)
        outlist := nil()$(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          := brace()$(FSET FSET S)
      for i in 1..#outList repeat
        newSet : FSET S := brace outList.i
        insert_! ( newSet , outSet )
      outSet

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

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

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

@
\section{package PGE PermutationGroupExamples}
<<package PGE PermutationGroupExamples>>=
)abbrev package PGE PermutationGroupExamples
++ Authors: M. Weller, G. Schneider, J. Grabmeier
++ Date Created: 20 February 1990
++ Date Last Updated: 09 June 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 PERM I
      import PERMGRP I

      -- import the needed map function:

      import 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:= nil()$(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:= nil()$(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

@
\section{License}
<<license>>=
--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.
@
<<*>>=
<<license>>

<<domain PERMGRP PermutationGroup>>
<<package PGE PermutationGroupExamples>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}
