axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / PERM.spad

)abbrev domain PERM Permutation
++ Authors: Johannes Grabmeier, Holger Gollan, Martin Rubey
++ Date Created: 19 May 1989
++ Date Last Updated: 2 June 2006
++ Reference: G. James/A. Kerber: The Representation Theory of the Symmetric
++   Group. Encycl. of Math. and its Appl., Vol. 16., Cambridge
++ Description:
++ Permutation(S) implements the group of all bijections
++ on a set S, which move only a finite number of points.
++ A permutation is considered as a map from S into S. In particular
++ multiplication is defined as composition of maps:\br
++ pi1 * pi2 = pi1 o pi2.\br
++ The internal representation of permuatations are two lists
++ of equal length representing preimages and images.

Permutation(S) : SIG == CODE where
  S : SetCategory

  B        ==> Boolean
  PI       ==> PositiveInteger
  I        ==> Integer
  L        ==> List
  NNI      ==> NonNegativeInteger
  V        ==> Vector
  PT       ==> Partition
  OUTFORM  ==> OutputForm
  RECCYPE  ==> Record(cycl: L L S, permut: %)
  RECPRIM  ==> Record(preimage: L S, image : L S)

  SIG ==> PermutationCategory S with

    listRepresentation : % -> RECPRIM
      ++ listRepresentation(p) produces a representation rep of
      ++ the permutation p as a list of preimages and images, i.e
      ++ p maps (rep.preimage).k to (rep.image).k for all
      ++ indices k. Elements of \spad{S} not in (rep.preimage).k
      ++ are fixed points, and these are the only fixed points of the
      ++ permutation.

    coercePreimagesImages : List List S -> %
      ++ coercePreimagesImages(lls) coerces the representation lls
      ++ of a permutation as a list of preimages and images to a permutation.
      ++ We assume that both preimage and image do not contain repetitions.
      ++ 
      ++X p := coercePreimagesImages([[1,2,3],[1,2,3]])
      ++X q := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4

    coerce : List List S -> %
      ++ coerce(lls) coerces a list of cycles lls to a
      ++ permutation, each cycle being a list with no
      ++ repetitions, is coerced to the permutation, which maps
      ++ ls.i to ls.i+1, indices modulo the length of the list,
      ++ then these permutations are mutiplied.
      ++ Error: if repetitions occur in one cycle.

    coerce : List S -> %
      ++ coerce(ls) coerces a cycle ls, a list with not
      ++ repetitions to a permutation, which maps ls.i to
      ++ ls.i+1, indices modulo the length of the list.
      ++ Error: if repetitions occur.

    coerceListOfPairs : List List S -> %
      ++ coerceListOfPairs(lls) coerces a list of pairs lls to a
      ++ permutation.
      ++ Error: if not consistent, the set of the first elements
      ++ coincides with the set of second elements.

    degree : % -> NonNegativeInteger
      ++ degree(p) retuns the number of points moved by the
      ++ permutation p.

    movedPoints : % -> Set S
      ++ movedPoints(p) returns the set of points moved by the permutation p.
      ++ 
      ++X p := coercePreimagesImages([[1,2,3],[1,2,3]])
      ++X movedPoints p

    cyclePartition : % -> Partition
      ++ cyclePartition(p) returns the cycle structure of a permutation
      ++ p including cycles of length 1 only if S is finite.

    order : % -> NonNegativeInteger
      ++ order(p) returns the order of a permutation p as a group element.

    numberOfCycles : % -> NonNegativeInteger
      ++ numberOfCycles(p) returns the number of non-trivial cycles of
      ++ the permutation p.

    sign : % -> Integer
      ++ sign(p) returns the signum of the permutation p, +1 or -1.

    even? : % -> Boolean
      ++ even?(p) returns true if and only if p is an even permutation,
      ++ sign(p) is 1.
      ++ 
      ++X p := coercePreimagesImages([[1,2,3],[1,2,3]])
      ++X even? p

    odd? : % -> Boolean
      ++ odd?(p) returns true if and only if p is an odd permutation
      ++ sign(p) is -1.

    sort : L % -> L %
      ++ sort(lp) sorts a list of permutations lp according to
      ++ cycle structure first according to length of cycles,
      ++ second, if S has \spadtype{Finite} or S has
      ++ \spadtype{OrderedSet} according to lexicographical order of
      ++ entries in cycles of equal length.

    if S has Finite then

      fixedPoints : % -> Set S
        ++ fixedPoints(p) returns the points fixed by the permutation p.
        ++X p := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4
        ++X fixedPoints p

    if S has IntegerNumberSystem or S has Finite then

      coerceImages : L S -> %
        ++ coerceImages(ls) coerces the list ls to a permutation
        ++ whose image is given by ls and the preimage is fixed
        ++ to be [1,...,n].
        ++ Note: {coerceImages(ls)=coercePreimagesImages([1,...,n],ls)}.
        ++ We assume that both preimage and image do not contain repetitions.

  CODE ==> add

    -- representation of the object:

    Rep  := V L S

    -- import of domains and packages

    import OutputForm

    import Vector List S

    -- variables

    p,q      : %

    exp      : I

    -- local functions first, signatures:

    smaller? : (S,S) -> B

    rotateCycle: L S -> L S

    coerceCycle: L L S -> %

    smallerCycle?: (L S, L S)  -> B

    shorterCycle?:(L S, L S)  -> B

    permord:(RECCYPE,RECCYPE)  -> B

    coerceToCycle:(%,B) -> L L S

    duplicates?: L S -> B

    smaller?(a:S, b:S): B ==
      S has OrderedSet => a <$S b
      S has Finite     => lookup a < lookup b
      false

    rotateCycle(cyc: L S): L S ==
      -- smallest element is put in first place
      -- doesn't change cycle if underlying set
      -- is not ordered or not finite.
      min:S := first cyc
      minpos:I := 1           -- 1 = minIndex cyc
      for i in 2..maxIndex cyc repeat
        if smaller?(cyc.i,min) then
          min  := cyc.i
          minpos := i
      (minpos = 1) => cyc
      concat(last(cyc,((#cyc-minpos+1)::NNI)),first(cyc,(minpos-1)::NNI))

    coerceCycle(lls : L L S): % ==
      perm : % := 1
      for lists in reverse lls repeat
        perm := cycle lists * perm
      perm

    smallerCycle?(cyca: L S, cycb: L S): B ==
      #cyca ^= #cycb =>
        #cyca < #cycb
      for i in cyca for j in cycb repeat
        i ^= j => return smaller?(i, j)
      false

    shorterCycle?(cyca: L S, cycb: L S): B ==
      #cyca < #cycb

    permord(pa: RECCYPE, pb : RECCYPE): B ==
      for i in pa.cycl for j in pb.cycl repeat
        i ^= j => return smallerCycle?(i, j)
      #pa.cycl < #pb.cycl

    coerceToCycle(p: %, doSorting?: B): L L S ==
      preim := p.1
      im := p.2
      cycles := nil()$(L L S)
      while not null preim repeat
        -- start next cycle
        firstEltInCycle: S := first preim
        nextCycle : L S := list firstEltInCycle
        preim := rest preim
        nextEltInCycle := first im
        im      := rest im
        while nextEltInCycle ^= firstEltInCycle repeat
          nextCycle := cons(nextEltInCycle, nextCycle)
          i := position(nextEltInCycle, preim)
          preim := delete(preim,i)
          nextEltInCycle := im.i
          im := delete(im,i)
        nextCycle := reverse nextCycle
        -- check on 1-cycles, we don't list these
        if not null rest nextCycle then
          if doSorting? and (S has OrderedSet or S has Finite) then
              -- put smallest element in cycle first:
              nextCycle := rotateCycle nextCycle
          cycles := cons(nextCycle, cycles)
      not doSorting? => cycles
      -- sort cycles
      S has OrderedSet or S has Finite =>
        sort(smallerCycle?,cycles)$(L L S)
      sort(shorterCycle?,cycles)$(L L S)

    duplicates? (ls : L S ): B ==
      x := copy ls
      while not null x repeat
        member? (first x ,rest x) => return true
        x := rest x
      false

    -- now the exported functions

    listRepresentation p ==
      s : RECPRIM := [p.1,p.2]

    coercePreimagesImages preImageAndImage ==
      preImage: List S := []
      image: List S := []
      for i in preImageAndImage.1 
        for pi in preImageAndImage.2 repeat
          if i ~= pi then
            preImage := cons(i, preImage)
            image := cons(pi, image)

      [preImage, image]

    movedPoints p == construct p.1

    degree p ==  #movedPoints p

    p = q ==
      #(preimp := p.1) ^= #(preimq := q.1) => false
      for i in 1..maxIndex preimp repeat
        pos := position(preimp.i, preimq)
        pos = 0 => return false
        (p.2).i ^= (q.2).pos => return false
      true

    orbit(p ,el) ==
      -- start with a 1-element list:
      out : Set S := brace list el
      el2 := eval(p, el)
      while el2 ^= el repeat
        -- be carefull: insert adds one element
        -- as side effect to out
        insert_!(el2, out)
        el2 := eval(p, el2)
      out

    cyclePartition p ==
      partition([#c for c in coerceToCycle(p, false)])$Partition

    order p ==
      ord: I := lcm removeDuplicates convert cyclePartition p
      ord::NNI

    sign(p) ==
      even? p => 1
      - 1

    even?(p) ==  even?(#(p.1) - numberOfCycles p)
      -- see the book of James and Kerber on symmetric groups
      -- for this formula.

    odd?(p) ==  odd?(#(p.1) - numberOfCycles p)

    pa < pb ==
      pacyc:= coerceToCycle(pa,true)
      pbcyc:= coerceToCycle(pb,true)
      for i in pacyc for j in pbcyc repeat
        i ^= j => return smallerCycle? ( i, j )
      maxIndex pacyc < maxIndex pbcyc

    coerce(lls : L L S): % == coerceCycle lls

    coerce(ls : L S): % == cycle ls

    sort(inList : L %): L % ==
      not (S has OrderedSet or S has Finite) => inList
      ownList: L RECCYPE := nil()$(L RECCYPE)
      for sigma in inList repeat
        ownList :=
          cons([coerceToCycle(sigma,true),sigma]::RECCYPE, ownList)
      ownList := sort(permord, ownList)$(L RECCYPE)
      outList := nil()$(L %)
      for rec in ownList repeat
        outList := cons(rec.permut, outList)
      reverse outList

    coerce (p: %): OUTFORM ==
      cycles: L L S := coerceToCycle(p,true)
      outfmL : L OUTFORM := nil()
      for cycle in cycles repeat
        outcycL: L OUTFORM := nil()
        for elt in cycle repeat
          outcycL := cons(elt :: OUTFORM, outcycL)
        outfmL := cons(paren blankSeparate reverse outcycL, outfmL)
      -- The identity element will be output as 1:
      null outfmL => outputForm(1@Integer)
      -- represent a single cycle in the form (a b c d)
      -- and not in the form ((a b c d)):
      null rest outfmL => first outfmL
      hconcat reverse outfmL

    cycles(vs ) == coerceCycle vs

    cycle(ls) ==
      #ls < 2 => 1
      duplicates? ls => error "cycle: the input contains duplicates"
      [ls, append(rest ls, list first ls)]

    coerceListOfPairs(loP) ==
      preim := nil()$(L S)
      im := nil()$(L S)
      for pair in loP repeat
        if first pair ^=  second pair then
          preim := cons(first pair, preim)
          im := cons(second pair, im)
      duplicates?(preim) or duplicates?(im) or brace(preim)$(Set S) _
        ^= brace(im)$(Set S) =>
        error "coerceListOfPairs: the input cannot be interpreted as a permutation"
      [preim, im]

    q * p ==
      -- use vectors for efficiency??
      preimOfp : V S := construct p.1
      imOfp : V S := construct p.2
      preimOfq := q.1
      imOfq := q.2
      preimOfqp   := nil()$(L S)
      imOfqp   := nil()$(L S)
      -- 1 = minIndex preimOfp
      for i in 1..(maxIndex preimOfp) repeat
        -- find index of image of p.i in q if it exists
        j := position(imOfp.i, preimOfq)
        if j = 0 then
          -- it does not exist
          preimOfqp := cons(preimOfp.i, preimOfqp)
          imOfqp := cons(imOfp.i, imOfqp)
        else
          -- it exists
          el := imOfq.j
          -- if the composition fixes the element, we don't
          -- have to do anything
          if el ^= preimOfp.i then
            preimOfqp := cons(preimOfp.i, preimOfqp)
            imOfqp := cons(el, imOfqp)
          -- we drop the parts of q which have to do with p
          preimOfq := delete(preimOfq, j)
          imOfq := delete(imOfq, j)
      [append(preimOfqp, preimOfq), append(imOfqp, imOfq)]

    1 == new(2,empty())$Rep

    inv p  == [p.2, p.1]

    eval(p, el) ==
      pos := position(el, p.1)
      pos = 0 => el
      (p.2).pos

    elt(p, el) == eval(p, el)

    numberOfCycles p == #coerceToCycle(p, false)

    if S has IntegerNumberSystem then

      coerceImages (image) ==
        preImage : L S := [i::S for i in 1..maxIndex image]
        coercePreimagesImages [preImage,image]

    if S has Finite then

      coerceImages (image) ==
        preImage : L S := [index(i::PI)::S for i in 1..maxIndex image]
        coercePreimagesImages [preImage,image]

      fixedPoints ( p ) == complement movedPoints p

      cyclePartition p ==
        pt := partition([#c for c in coerceToCycle(p, false)])$Partition
        pt +$PT conjugate(partition([#fixedPoints(p)])$PT)$PT