aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/perm.spad.pamphlet
blob: e0f014d10568bf14997238b8861b492e44d15a8a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
\documentclass{article}
\usepackage{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, eval, 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  ==  Group 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.
    eval  :  (%,S)          ->  S
      ++ eval(p, el) returns the image of {\em el} under the
      ++ permutation p.
    elt  :  (%,S)          ->  S
      ++ elt(p, el) returns the image of {\em el} under the
      ++ permutation 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, movedPoints, 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.
    movedPoints       :  %                ->  Set S
      ++ movedPoints(p) returns the set 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 [[movedPoints]], [[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]])
  movedPoints 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>>=

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

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

      cyclePartition p ==
        pt := partition([#c for c in coerceToCycle(p, false)])$Partition
        pt +$PT conjugate(partition([#fixedPoints(p)])$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}