)abbrev domain PRTITION Partition
++ Domain for partitions of positive integers
++ Author: William H. Burge
++ Date Created: 29 October 1987
++ Keywords:
++ Examples:
++ References:
Partition : Exports == Implementation where
  ++ Partition is an OrderedCancellationAbelianMonoid which is used
  ++ as the basis for symmetric polynomial representation of the
  ++ sums of powers in SymmetricPolynomial.  Thus, \spad{(5 2 2 1)} will
  ++ represent \spad{s5 * s2^2 * s1}.
  L   ==> List
  I   ==> Integer
  OUT ==> OutputForm
  NNI ==> NonNegativeInteger
  UN  ==> Union(%,"failed")

  Exports ==> Join(OrderedCancellationAbelianMonoid,
                   ConvertibleTo List Integer) with
    partition : L I -> %
      ++ partition(li) converts a list of integers li to a partition
    powers : L I -> L L I
      ++ powers(li) returns a list of 2-element lists.  For each 2-element
      ++ list, the first element is an entry of li and the second
      ++ element is the multiplicity with which the first element
      ++ occurs in li.  There is a 2-element list for each value
      ++ occurring in l.
    pdct : % -> I
      ++ \spad{pdct(a1^n1 a2^n2 ...)} returns
      ++ \spad{n1! * a1^n1 * n2! * a2^n2 * ...}.
      ++ This function is used in the package \spadtype{CycleIndicators}.
    conjugate : % -> %
      ++ conjugate(p) returns the conjugate partition of a partition p
    coerce : % -> List Integer
      ++ coerce(p) coerces a partition into a list of integers

  Implementation ==> add

    import from PartitionsAndPermutations

    Rep := List Integer
    0 == []

    coerce (s : %) : List(Integer) == s::Rep
    convert x == copy(x::Rep)$L(I)

    partition list == sort((i1 : Integer, i2 : Integer) : Boolean +-> i2 < i1, list)

    x < y ==
      empty? x => not empty? y
      empty? y => false
      first x = first y => rest x < rest y
      first x < first y

    x = y ==
        EQUAL(x, y)$Lisp
--      empty? x => empty? y
--      empty? y => false
--      first x = first y => rest x = rest y
--      false

    x + y ==
      empty? x => y
      empty? y => x
      first x > first y => concat(first x, rest(x) + y)
      concat(first y, x + rest(y))
    n : NNI * x : % == (zero? n => 0; x + (subtractIfCan(n, 1) :: NNI) * x)

    dp : (I, %) -> %
    dp(i, x) ==
      empty? x => 0
      first x = i => rest x
      concat(first x, dp(i, rest x))

    remv : (I, %) -> UN
    remv(i,x) == (member?(i,x) => dp(i,x); "failed")

    subtractIfCan(x, y) ==
      empty? x =>
        empty? y => 0
        "failed"
      empty? y => x
      (aa := remv(first y,x)) case "failed" => "failed"
      subtractIfCan((aa :: %), rest y)

    li1 : L I  --!! 'bite' won't compile without this
    bite : (I, L I) -> L I
    bite(i, li) ==
      empty? li => concat(0, [])
      first li = i =>
        li1 := bite(i, rest li)
        concat(first(li1) + 1, rest li1)
      concat(0, li)

    li : L I  --!!  'powers' won't compile without this
    powers l ==
      empty?(l) => []
      li := bite(first l, rest l)
      concat([first l, first(li) + 1], powers(rest li))

    conjugate x == conjugate(x pretend Rep)$PartitionsAndPermutations

    mkterm : (I, I) -> OUT
    mkterm(i1, i2) ==
      i2 = 1 => (i1 :: OUT) ^ message(" ")
      (i1 :: OUT) ^ (i2 :: OUT)

    mkexp1 : L L I -> L OUT
    mkexp1 lli ==
      empty?(lli) => []
      li := first lli
      empty?(rest lli) and second(li) = 1 =>
        concat(first(li)::OUT, [])
      concat(mkterm(first li, second li), mkexp1(rest lli))

    coerce(x : %) : OUT ==
        empty? (x pretend Rep) => coerce(x pretend Rep)$Rep
        paren(reduce("*",mkexp1(powers(x pretend Rep))))

    pdct x ==
      */[factorial(second a) * (first(a) ^ (second(a) pretend NNI))
                 for a in powers(x pretend Rep)]

)abbrev domain SYMPOLY SymmetricPolynomial
++ Description:
++ This domain implements symmetric polynomial
SymmetricPolynomial(R : Ring) == PolynomialRing(R, Partition) add
       Term :=  Record(k : Partition, c : R)
       Rep :=  List Term

-- override PR implementation because coeff. arithmetic too expensive (??)

       if R has EntireRing then
         (p1 : %) * (p2 : %)  ==
            empty?(p1) => 0
            empty?(p2) => 0
            zero?(p1.first.k) => p1.first.c * p2
            (p2 = 1) => p1
            +/[[[t1.k+t2.k, t1.c*t2.c]$Term for t2 in p2]
                   for t1 in reverse(p1)]
                   -- This 'reverse' is an efficiency improvement:
                   -- reduces both time and space [Abbott/Bradford/Davenport]
        else
         (p1 : %) * (p2 : %)  ==
            empty?(p1) => 0
            empty?(p2) => 0
            zero?(p1.first.k) => p1.first.c * p2
            (p2 = 1) => p1
            +/[[[t1.k+t2.k, r]$Term for t2 in p2 | (r := t1.c*t2.c) ~= 0]
                 for t1 in reverse(p1)]
                  -- This 'reverse' is an efficiency improvement:
                  -- reduces both time and space [Abbott/Bradford/Davenport]

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