)abbrev domain TABLEAU Tableau
++ Author: William H. Burge
++ Date Created: 1987
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: Young tableau
++ References:
++ Description:
++ The tableau domain is for printing Young tableaux, and
++ coercions to and from List List S where S is a set.
Tableau(S : SetCategory) : Exports == Implementation where
  L   ==> List
  I   ==> Integer
  NNI ==> NonNegativeInteger
  OUT ==> OutputForm
  V   ==> Vector
  Exports ==> CoercibleTo(OutputForm) with
    tableau : L L S -> %
      ++ tableau(ll) converts a list of lists ll to a tableau.
    listOfLists : % -> L L S
      ++ listOfLists t converts a tableau t to a list of lists.
  Implementation ==> add

    Rep := L L S

    tableau(lls : (L L S)) == lls pretend %
    listOfLists(x : %) : (L L S) == x pretend (L L S)
    makeupv : (NNI, L S) -> L OUT
    makeupv(n, ls)==
        v := new(n,message " ")$(List OUT)
        for i in 1..#ls for s in  ls repeat v.i := box(s::OUT)
        v
    maketab : L L S -> OUT
    maketab lls ==
      ll :  L OUT :=
        empty? lls => [[empty()]]
        sz : NNI := # first lls
        [blankSeparate makeupv(sz, i) for i in lls]
      pile ll

    coerce(x : %) : OUT == maketab listOfLists x

)abbrev package TABLBUMP TableauxBumpers
++ Author: William H. Burge
++ Date Created: 1987
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: Young tableau
++ References:
++ Description:
++ TableauBumpers implements the Schenstead-Knuth
++ correspondence between sequences and pairs of Young tableaux.
++ The 2 Young tableaux are represented as a single tableau with
++ pairs as components.
TableauxBumpers(S : OrderedSet) : T==C where
     L==>List
     ST==>Stream
     B==>Boolean
     ROW==>Record(fs : B, sd : L S, td : L L S)
     RC==>Record(f1 : L S, f2 : L L L S, f3 : L L S, f4 : L L L S)
     PAIR==>L S
     T== with
       bumprow : ((S, S)->B, PAIR, L PAIR)->ROW
         ++ bumprow(cf, pr, r) is an auxiliary function which
         ++ bumps a row r with a pair pr
         ++ using comparison function cf, and returns a record
       bumptab : ((S, S)->B, PAIR, L L PAIR)->L L PAIR
         ++ bumptab(cf, pr, t) bumps a tableau t with a pair pr
         ++ using comparison function cf, returning a new tableau
       bumptab1 : (PAIR, L L PAIR)->L L PAIR
         ++ bumptab1(pr, t) bumps a tableau t with a pair pr
         ++ using comparison function \spadfun{<},
         ++ returning a new tableau
       untab : (L PAIR, L L PAIR)->L PAIR
         ++ untab(lp, llp) is an auxiliary function
         ++ which unbumps a tableau llp,
         ++ using lp to accumulate pairs
       bat1 : L L PAIR->L PAIR
         ++ bat1(llp) unbumps a tableau llp.
         ++ Operation bat1 is the inverse of tab1.
       bat : Tableau(L S)->L L S
         ++ bat(ls) unbumps a tableau ls
       tab1 : L PAIR->L L PAIR
         ++ tab1(lp) creates a tableau from a list of pairs lp
       tab : L S->Tableau(L S)
         ++ tab(ls) creates a tableau from ls by first creating
         ++ a list of pairs using \spadfunFrom{slex}{TableauBumpers},
         ++ then creating a tableau using \spadfunFrom{tab1}{TableauBumpers}.
       lex : L PAIR->L PAIR
         ++ lex(ls) sorts a list of pairs to lexicographic order
       slex : L S->L PAIR
         ++ slex(ls) sorts the argument sequence ls, then
         ++ zips (see \spadfunFrom{map}{ListFunctions3}) the
         ++ original argument sequence with the sorted result to
         ++ a list of pairs
       inverse : L S->L S
         ++ inverse(ls) forms the inverse of a sequence ls
       maxrow : (PAIR, L L PAIR, L PAIR, L L PAIR, L L PAIR, L L PAIR)->RC
         ++ maxrow(a, b, c, d, e) is an auxiliary function for mr
       mr : L L PAIR->RC
         ++ mr(t) is an auxiliary function which
         ++ finds the position of the maximum element of a tableau t
         ++ which is in the lowest row, producing a record of results
     C== add
       cf : (S, S)->B
       bumprow(cf, x : (PAIR), lls : (L PAIR))==
         if empty?(lls)
         then [false, x, [x]]$ROW
         else (y : (PAIR) := first lls;
               if cf(x.2, y.2)
               then [true, [x.1, y.2], cons([y.1, x.2], rest lls)]$ROW
               else (rw : ROW := bumprow(cf, x, rest lls);
                       [rw.fs, rw.sd, cons(first lls, rw.td)]$ROW ))

       bumptab(cf, x : (PAIR), llls : (L L PAIR))==
           if empty?(llls)
           then [[x]]
           else (rw : ROW := bumprow(cf, x, first llls);
                 if rw.fs
                 then cons(rw.td, bumptab(cf, rw.sd, rest llls))
                 else cons(rw.td, rest llls))

       bumptab1(x, llls) == bumptab((s1, s2) +-> s1 < s2, x, llls)

       rd==> reduce$StreamFunctions2(PAIR, L L PAIR)
       tab1(lls : (L PAIR))== rd([], bumptab1, lls::(ST PAIR))

       srt==>sort$(PAIR)
       lexorder : (PAIR, PAIR)->B
       lexorder(p1, p2)==if p1.1 = p2.1 then p1.2<p2.2 else p1.1<p2.1
       lex lp == (sort$(L PAIR))((s1, s2) +-> lexorder(s1, s2), lp)
       slex ls == lex([[i, j] for i in srt((s1, s2) +-> s1 < s2, ls)
                              for j in ls])
       inverse ls==[lss.2 for lss in
                    lex([[j, i] for i in srt((s1, s2) +-> s1 < s2, ls)
                               for j in ls])]

       tab(ls : (PAIR))==(tableau tab1 slex ls )

       maxrow(n, a, b, c, d, llls)==
        if empty?(llls) or empty?(first(llls))
        then [n, a, b, c]$RC
        else (fst := first first llls;rst := rest first llls;
              if fst.1>n.1
              then maxrow(fst, d, rst, rest llls, cons(first llls, d), rest llls)
              else maxrow(n, a, b, c, cons(first llls, d), rest llls))

       mr llls==maxrow(first first llls, [], rest first llls, rest llls,
                                                               [], llls)

       untab(lp, llls)==
         if empty?(llls)
         then lp
         else (rc : RC := mr llls;
               rv := reverse (bumptab((s1 : S, s2 : S) : B +-> s2 < s1,
                                      rc.f1, rc.f2));
               untab(cons(first first rv, lp)
                     , append(rest rv,
                                         if empty?(rc.f3)
                                         then []
                                         else cons(rc.f3, rc.f4))))

       bat1 llls==untab([], [reverse lls for lls in llls])
       bat tb==bat1(listOfLists tb)

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