(*

Tableaux.m

This Mathematica package implements a number of functions commonly used
with tableaux. Here, a tableau is implemented as a list of lists of
positive integers; skew shapes have -1's to denote "nonexistent"
squares.

This version: Wed Dec  1 12:09:19 CST 2004.                  %DATE_TAG%

The current version of this package and some possibly useful
documentation is available from http://www.math.umn.edu/~drake/.


  (c) 2004 Dan Drake <drake@math.umn.edu>

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at
  your option) any later version.

  This program is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  General Public License for more details.

  The GNU GPL is available at http://www.gnu.org/licenses/gpl.html.

*)

(* 
  TODO:
  redo For loops with something faster
*)

BeginPackage["Tableaux`", {"DiscreteMath`Combinatorica`"}]

Off[spell]

PartitionToFerrersShape::usage = "PartitionToFerrersShape[p] converts a
partition p to a Ferrers shape, which is a list of list of zeros
corresponding to an un-filled-in tableau of shape p. PTFS[p,k] produces
a Ferrers shape filled with k's, and PFTFS[p,q] produces a skew tableau
if p and q are both partitions and p > q in lex order."

FerrersShapeToPartition::usage = "FerrersShapeToPartition converts a
list of lists into the corresponding composition. It is meant to be used
on Ferrers shapes, so that you get partitions."

Compositions::usage = "Compositions[n,lst] returns compositions of n
whose 'pattern' matches lst. For example, Compositions[5,{3,4,1}]
returns a list of compositions of 5 into three parts, the first of which
is <= 3, the second <= 4, etc. Compositions[n] returns a list of all
compositions of n. Other functions of Compositions are unchanged."

KostkaSet::usage = "KostkaSet[l,m] returns the set of semistandard
tableaux of shape l and content m."

KostkaNumber::usage = "KostkaNumber[l,m] returns the Kostka number for a
partition l and composition m, which is the number of semistandard
tableaux of shape l and content m."

KostkaMatrix::usage = "Returns the Kostka matrix of order n. The rows
and columns are indexed by partitions of n in reverse lex order, and
the (a,b) entry is KostkaNumber[a,b]."

Begin["`Private`"]

(* this works for non-skew tableaux *)
AddTableaux[a_List, b_List] :=
  Join[
    Table[a[[i]] + PadRight[b[[i]], Length[a[[i]]]], {i, 1, Length[b]}],
    Table[a[[i]], {i, Length[b] + 1, Length[a]}]
  ]

PartitionToFerrersShape[p_?PartitionQ] := 
  Table[Table[0, {i, 1, p[[j]]}], {j, 1, Length[p]}];
PartitionToFerrersShape[p_?PartitionQ, k_Integer] :=
  Table[Table[k, {i, 1, p[[j]]}], {j, 1, Length[p]}];
PartitionToFerrersShape[p_?PartitionQ, q_?PartitionQ] /; ListLE[q, p] :=
  If[p == q, {},
    AddTableaux[PartitionToFerrersShape[p], PartitionToFerrersShape[q, -1]]
  ]

FerrersShapeToPartition[x:{__List}] :=
  Map[Length, x]

(* given a tableau and an integer, this returns a list of nonnegative
   integers: {1,3,2} means row 1 has 1 uncovered cell for k, row 2 has 3
   uncovered cells for k, etc.

   Having, say, 3 uncovered cells in a row means there are three cells
   in that row where you could put your integer k and maintain
   semistandard-ness. *)
CountUncoveredCells[x:{{__Integer}..}, k_Integer] :=
  Map[CountUncoveredCells[x,#1,k]&, Range[Length[x]]]

(* this does it row-by-row; you shouldn't ever need to call this
   directly *)
CountUncoveredCells[x:{{__Integer}..}, i_Integer?Positive, k_Integer] := 
  If[i==1, Count[x[[1]], 0],
    Count[Range[Length[x[[i]]]], j_/; (x[[i]][[j]] == 0 &&
                                       x[[i-1]][[j]] != 0 &&
                                       Max[Table[x[[a]][[j]], {a,1,i-1}]] < k)]
    ]

(* lex order on lists. *)
ListLE[a_List, b_List] :=
  Apply[And, MapThread[LessEqual, {Take[a, Min[Length[a], Length[b]]],
                                   Take[b, Min[Length[a], Length[b]]]}]]

(* we're overloading Compositions (to use C++ terminology), so we need to
   unprotect the symbol first. Amazingly, it's not spelled UnProtect. *)
Unprotect[Compositions]

(* count compositions that match a pattern : Compositions[5, {3, 4, 1}]
   returns compositions of 5 whose first part is <= 3, second part <= 4,
   etc *)
Compositions[n_, l:{__Integer}] :=
  Select[Compositions[n, Length[l]], (ListLE[#1, l])&]

(* while we're at it...Compositions[n] should return a list of all
   compositions of n. The 'Union' removes repeated elements from the
   Map'ed list. We only do up to n-2 parts because Compositions[n,n]
   returns a *very* long list with many redundant compositions. So we
   only go up to n-2 (speeds up by factor of 4 or more!) and union in
   the extra compositions, which are easy to generate. *)
Compositions[n_] :=
  Union[Map[Cases[#1, _?Positive]&, Compositions[n, Max[n-2,2]]],
    Table[If[i == j, 2, 1], {i, 1, n-1}, {j, 1, n-1}],
    {Table[1, {i, 1, n}]}
  ]

(* this takes things like {{{a,b}}} and returns {a,b}. *)
UnListify[x_List] :=
  NestWhile[Apply[Identity, #1]&, x, (Length[#1] == 1)&]

(* replace the first n k's in list x with l *)
ReplaceNKsWithL[n_Integer?NonNegative, k_, l_, x_List] := 
  ReplacePart[x, l, Position[x, k, 1, n]]

(* insert k's into the tableau t according to the composition c *)
kinsert[t_, c_, l_] :=
  Module[{i, x = t},
    For[i = 1, i <= Length[c], i++,
      x[[i]] = ReplaceNKsWithL[c[[i]], 0, l, x[[i]]];
    ];
    x
  ]

(* 
I've checked this for Young tableaux for all partitions of weight <= 12,
and it works. I've also checked that K_l,l = 1 for all partitions of
weight <= 15. The Kostka matrices agree with the ones in MacDonald's
book. I'm willing to say that it works.
*)

KostkaSet[t:{{__Integer}..}, m:{___Integer}, k_Integer?Positive] := 
  If[(DominatingIntegerPartitionQ[FerrersShapeToPartition[t], m] &&
     Count[Flatten[t], 0] == Total[m]) || k > 1,
    Module[{ans={}, comps=Compositions[m[[1]], CountUncoveredCells[t, k]],
      i, j, u},
      For[i = 1, i <= Length[comps], i++,
        u = kinsert[t, comps[[i]], k];
        If[MemberQ[u, 0, 2],
          ans = Join[ans, KostkaSet[u, Rest[m], k+1]],
          AppendTo[ans, u]]];
      ans], 
    {}]

KostkaSet[t_?PartitionQ, m_?PartitionQ] :=
  KostkaSet[PartitionToFerrersShape[t], m, 1]

KostkaNumber[l_?PartitionQ, m:{__Integer?NonNegative}] :=
  Length[KostkaSet[l, m]]

KostkaMatrix[n_Integer?Positive] := Module[{p = Partitions[n]},
  Table[KostkaNumber[p[[i]], p[[j]]], {i, 1, Length[p]}, {j, 1, Length[p]}]]

End[]

EndPackage[]