--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.

)abbrev category PERMCAT PermutationCategory
++ Authors:  Holger Gollan, Johannes Grabmeier, Gerhard Schneider
++ Date Created: 27 July 1989
++ Date Last Updated: 29 March 1990
++ Basic Operations: cycle, cycles, orbit
++ Related Constructors: PermutationGroup, PermutationGroupExamples
++ Also See: RepresentationTheoryPackage1
++ AMS Classifications:
++ Keywords: permutation, symmetric group
++ References:
++ Description: PermutationCategory provides a categorial environment
++  for subgroups of bijections of a set (i.e. permutations)

PermutationCategory(S:SetCategory): Category ==
  Join(Group,Eltable(S,S)) with
    cycle   :  List S       ->  %
      ++ cycle(ls) coerces a cycle {\em ls}, i.e. a list with not
      ++ repetitions to a permutation, which maps {\em ls.i} to
      ++ {\em ls.i+1}, indices modulo the length of the list.
      ++ Error: if repetitions occur.
    cycles  :  List List S  ->  %
      ++ cycles(lls) coerces a list list of cycles {\em lls}
      ++ to a permutation, each cycle being a list with not
      ++ repetitions, is coerced to the permutation, which maps
      ++ {\em ls.i} to {\em ls.i+1}, indices modulo the length of the list,
      ++ then these permutations are mutiplied.
      ++ Error: if repetitions occur in one cycle.
    support: % -> Set S
      ++ \spad{support p} returns the set of points not fixed by the
      ++ permutation \spad{p}.
    orbit :  (%,S)          ->  Set S
      ++ orbit(p, el) returns the orbit of {\em el} under the
      ++ permutation p, i.e. the set which is given by applications of
      ++ the powers of p to {\em el}.
    < : (%,%)             ->  Boolean
      ++ p < q is an order relation on permutations.
      ++ Note: this order is only total if and only if S is totally ordered
      ++ or S is finite.
    if S has OrderedSet then OrderedSet
    if S has Finite then OrderedSet

)abbrev domain PERM Permutation
++ Authors: Johannes Grabmeier, Holger Gollan
++ Date Created: 19 May 1989
++ Date Last Updated: 2 June 2006
++ Basic Operations: _*, degree, support, cyclePartition, order,
++  numberOfCycles, sign, even?, odd?
++ Related Constructors: PermutationGroup, PermutationGroupExamples
++ Also See: RepresentationTheoryPackage1
++ AMS Classifications:
++ Keywords:
++ 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:
++   {\em pi1 * pi2 = pi1 o pi2}.
++   The internal representation of permuatations are two lists
++   of equal length representing preimages and images.

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

  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)

  public ==> PermutationCategory S with

    listRepresentation:  %                ->  RECPRIM
      ++ listRepresentation(p) produces a representation {\em rep} of
      ++ the permutation p as a list of preimages and images, i.e
      ++ p maps {\em (rep.preimage).k} to {\em (rep.image).k} for all
      ++ indices k. Elements of \spad{S} not in {\em (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 {\em 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.
    coerce            :  List List S      ->  %
      ++ coerce(lls) coerces a list of cycles {\em lls} to a
      ++ permutation, each cycle being a list with no
      ++ repetitions, is coerced to the permutation, which maps
      ++ {\em ls.i} to {\em 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 {\em ls}, i.e. a list with not
      ++ repetitions to a permutation, which maps {\em ls.i} to
      ++ {\em 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 {\em lls} to a
      ++ permutation.
      ++ Error: if not consistent, i.e. the set of the first elements
      ++ coincides with the set of second elements.
    --coerce            :  %                ->  OUTFORM
      ++ coerce(p) generates output of the permutation p with domain
      ++ OutputForm.
    degree            :  %                ->  NonNegativeInteger
      ++ degree(p) retuns the number of points moved by the
      ++ permutation 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,
      ++ i.e. {\em sign(p)} is 1.
    odd?              :  %                ->  Boolean
      ++ odd?(p) returns true if and only if p is an odd permutation
      ++ i.e. {\em sign(p)} is {\em -1}.
    sort              :  L %              ->  L %
      ++ sort(lp) sorts a list of permutations {\em 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.
    if S has IntegerNumberSystem or S has Finite then
      coerceImages    :  L S              ->  %
        ++ coerceImages(ls) coerces the list {\em ls} to a permutation
        ++ whose image is given by {\em ls} and the preimage is fixed
        ++ to be {\em [1,...,n]}.
        ++ Note: {coerceImages(ls)=coercePreimagesImages([1,...,n],ls)}.
        ++ We assume that both preimage and image do not contain repetitions.

  private ==> 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
      one? minpos => 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]

    support p == construct p.1

    degree p ==  #support 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 := p(el)
      while el2 ~= el repeat
        -- be carefull: insert adds one element
        -- as side effect to out
        insert!(el2, out)
        el2 := p(el2)
      out

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

    order p ==
      ord: I := lcm removeDuplicates(cyclePartition(p)::L(PI) pretend L I)
      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]

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

    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 support p

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

