\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra perm.spad}
\author{Holger Gollan, Johannes Grabmeier, Gerhard Schneider}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{category PERMCAT PermutationCategory}
<<category PERMCAT PermutationCategory>>=
)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

@
\section{domain PERM Permutation}
<<domain PERM Permutation>>=
)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
@

We represent a permutation as two lists of equal length representing preimages
and images of moved points. I.e., fixed points do not occur in either of these
lists. This enables us to compute the set of fixed points and the set of moved
points easily.

Note that this was not respected in versions before [[patch--50]] of this
domain.

<<domain PERM Permutation>>=
    -- 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]
@ 

This operation transforms a pair of preimages and images into an element of the
domain. Since we assume that fixed points do not occur in the representation,
we have to sort them out here. 

Note that before [[patch--50]] this read
\begin{verbatim}
      coercePreimagesImages preImageAndImage ==
      p : % := [preImageAndImage.1,preImageAndImage.2]
\end{verbatim}
causing bugs when computing [[support]], [[fixedPoints]], [[even?]],
[[odd?]], etc., as reported in Issue~\#295.

The other coercion facilities check for fixed points. It also seems that [[*]]
removes fixed points from its result.

<<TEST PERM>>=
  p := coercePreimagesImages([[1,2,3],[1,2,3]])
  support p        -- should return {}
  even? p          -- should return true
  p := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4
  fixedPoints p    -- should return {2}
  q := coercePreimagesImages([[0,1,2,3],[1,0]])$PERM ZMOD 4
  fixedPoints(p*q) -- should return {2,0}
  even?(p*q)       -- should return false
@

<<domain PERM Permutation>>=

    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]
@

Up to [[patch--50]] we did not check for duplicates.

<<domain PERM Permutation>>=
    if S has Finite then

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

Up to [[patch--50]] we did not check for duplicates.

<<domain PERM Permutation>>=
      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

@
\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>>

<<category PERMCAT PermutationCategory>>
<<domain PERM Permutation>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}