-- | Young tableaux and similar gadgets. 
--
--   See e.g. William Fulton: Young Tableaux, with Applications to 
--   Representation theory and Geometry (CUP 1997).
-- 
--   The convention is that we use 
--   the English notation, and we store the tableaux as lists of the rows.
-- 
--   That is, the following standard Young tableau of shape [5,4,1]
-- 
-- >  1  3  4  6  7
-- >  2  5  8 10
-- >  9
--
-- <<svg/young_tableau.svg>>
--
--   is encoded conveniently as
-- 
-- > [ [ 1 , 3 , 4 , 6 , 7 ]
-- > , [ 2 , 5 , 8 ,10 ]
-- > , [ 9 ]
-- > ]
--

{-# LANGUAGE CPP, BangPatterns, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
module Math.Combinat.Tableaux where

--------------------------------------------------------------------------------

import Data.List

import Math.Combinat.Classes
import Math.Combinat.Numbers ( factorial , binomial )
import Math.Combinat.Partitions.Integer
import Math.Combinat.Partitions.Integer.IntList ( _dualPartition )
import Math.Combinat.ASCII
import Math.Combinat.Helper

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- * Basic stuff

-- | A tableau is simply represented as a list of lists.
type Tableau a = [[a]]

-- | ASCII diagram of a tableau
asciiTableau :: Show a => Tableau a -> ASCII
asciiTableau :: forall a. Show a => Tableau a -> ASCII
asciiTableau Tableau a
t = (HAlign, VAlign) -> (HSep, VSep) -> [[ASCII]] -> ASCII
tabulate (HAlign
HRight,VAlign
VTop) (Int -> HSep
HSepSpaces Int
1, VSep
VSepEmpty) 
           forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) forall a. Show a => a -> ASCII
asciiShow
           forall a b. (a -> b) -> a -> b
$ Tableau a
t

instance CanBeEmpty (Tableau a) where
  empty :: Tableau a
empty   = []
  isEmpty :: Tableau a -> Bool
isEmpty = forall (t :: * -> *) a. Foldable t => t a -> Bool
null

instance Show a => DrawASCII (Tableau a) where 
  ascii :: Tableau a -> ASCII
ascii = forall a. Show a => Tableau a -> ASCII
asciiTableau

_tableauShape :: Tableau a -> [Int]
_tableauShape :: forall a. Tableau a -> [Int]
_tableauShape Tableau a
t = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length Tableau a
t 

-- | The shape of a tableau
tableauShape :: Tableau a -> Partition
tableauShape :: forall a. Tableau a -> Partition
tableauShape Tableau a
t = [Int] -> Partition
toPartition (forall a. Tableau a -> [Int]
_tableauShape Tableau a
t)

instance HasShape (Tableau a) Partition where
  shape :: Tableau a -> Partition
shape = forall a. Tableau a -> Partition
tableauShape

-- | Number of entries
tableauWeight :: Tableau a -> Int
tableauWeight :: forall a. Tableau a -> Int
tableauWeight = forall a. Num a => [a] -> a
sum' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length

instance HasWeight (Tableau a) where
  weight :: Tableau a -> Int
weight = forall a. Tableau a -> Int
tableauWeight

-- | The dual of the tableau is the mirror image to the main diagonal.
dualTableau :: Tableau a -> Tableau a
dualTableau :: forall a. Tableau a -> Tableau a
dualTableau = forall a. Tableau a -> Tableau a
transpose

instance HasDuality (Tableau a) where
  dual :: Tableau a -> Tableau a
dual = forall a. Tableau a -> Tableau a
dualTableau

-- | The content of a tableau is the list of its entries. The ordering is from the left to the right and
-- then from the top to the bottom
tableauContent :: Tableau a -> [a]
tableauContent :: forall a. Tableau a -> [a]
tableauContent = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

-- | An element @(i,j)@ of the resulting tableau (which has shape of the
-- given partition) means that the vertical part of the hook has length @i@,
-- and the horizontal part @j@. The /hook length/ is thus @i+j-1@. 
--
-- Example:
--
-- > > mapM_ print $ hooks $ toPartition [5,4,1]
-- > [(3,5),(2,4),(2,3),(2,2),(1,1)]
-- > [(2,4),(1,3),(1,2),(1,1)]
-- > [(1,1)]
--
hooks :: Partition -> Tableau (Int,Int)
hooks :: Partition -> Tableau (Int, Int)
hooks Partition
part = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b}. (Num b, Enum b) => b -> Int -> [(Int, b)]
f [Int]
p [Int
1..] where 
  p :: [Int]
p = Partition -> [Int]
fromPartition Partition
part
  q :: [Int]
q = [Int] -> [Int]
_dualPartition [Int]
p
  f :: b -> Int -> [(Int, b)]
f b
l Int
i = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x b
y -> (Int
xforall a. Num a => a -> a -> a
-Int
iforall a. Num a => a -> a -> a
+Int
1,b
y)) [Int]
q [b
l,b
lforall a. Num a => a -> a -> a
-b
1..b
1] 

hookLengths :: Partition -> Tableau Int
hookLengths :: Partition -> Tableau Int
hookLengths Partition
part = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (\(Int
i,Int
j) -> Int
iforall a. Num a => a -> a -> a
+Int
jforall a. Num a => a -> a -> a
-Int
1) (Partition -> Tableau (Int, Int)
hooks Partition
part) 

--------------------------------------------------------------------------------
-- * Row and column words

-- | The /row word/ of a tableau is the list of its entry read from the right to the left and then
-- from the top to the bottom.
rowWord :: Tableau a -> [a]
rowWord :: forall a. Tableau a -> [a]
rowWord = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | /Semistandard/ tableaux can be reconstructed from their row words
rowWordToTableau :: Ord a => [a] -> Tableau a
rowWordToTableau :: forall a. Ord a => [a] -> Tableau a
rowWordToTableau [a]
xs = forall a. [a] -> [a]
reverse [[a]]
rows where
  rows :: [[a]]
rows = forall a. Ord a => [a] -> Tableau a
break [a]
xs
  break :: [a] -> [[a]]
break [] = [[]]
  break [a
x] = [[a
x]]
  break (a
x:xs :: [a]
xs@(a
y:[a]
_)) = if a
xforall a. Ord a => a -> a -> Bool
>a
y
    then [a
x] forall a. a -> [a] -> [a]
: [a] -> [[a]]
break [a]
xs
    else let ([a]
h:[[a]]
t) = [a] -> [[a]]
break [a]
xs in (a
xforall a. a -> [a] -> [a]
:[a]
h)forall a. a -> [a] -> [a]
:[[a]]
t

-- | The /column word/ of a tableau is the list of its entry read from the bottom to the top and then from the left to the right
columnWord :: Tableau a -> [a]
columnWord :: forall a. Tableau a -> [a]
columnWord = forall a. Tableau a -> [a]
rowWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tableau a -> Tableau a
transpose

-- | /Standard/ tableaux can be reconstructed from either their column or row words
columnWordToTableau :: Ord a => [a] -> Tableau a
columnWordToTableau :: forall a. Ord a => [a] -> Tableau a
columnWordToTableau = forall a. Tableau a -> Tableau a
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Tableau a
rowWordToTableau

-- | Checks whether a sequence of positive integers is a /lattice word/, 
-- which means that in every initial part of the sequence any number @i@
-- occurs at least as often as the number @i+1@
--
isLatticeWord :: [Int] -> Bool
isLatticeWord :: [Int] -> Bool
isLatticeWord = Map Int Int -> [Int] -> Bool
go forall k a. Map k a
Map.empty where
  go :: Map Int Int -> [Int] -> Bool
  go :: Map Int Int -> [Int] -> Bool
go Map Int Int
_      []     = Bool
True
  go !Map Int Int
table (Int
i:[Int]
is) =
    if Int -> Bool
check Int
i
      then Map Int Int -> [Int] -> Bool
go Map Int Int
table' [Int]
is
      else Bool
False
    where
      table' :: Map Int Int
table'  = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Num a => a -> a -> a
(+) Int
i Int
1 Map Int Int
table
      check :: Int -> Bool
check Int
j = Int
jforall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
|| Int -> Int
cnt (Int
jforall a. Num a => a -> a -> a
-Int
1) forall a. Ord a => a -> a -> Bool
>= Int -> Int
cnt Int
j
      cnt :: Int -> Int
cnt Int
j   = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
j Map Int Int
table' of
        Just Int
k  -> Int
k
        Maybe Int
Nothing -> Int
0

--------------------------------------------------------------------------------
-- * Semistandard Young tableaux

-- | A tableau is /semistandard/ if its entries are weekly increasing horizontally
-- and strictly increasing vertically
isSemiStandardTableau :: Tableau Int -> Bool
isSemiStandardTableau :: Tableau Int -> Bool
isSemiStandardTableau Tableau Int
t = Bool
weak Bool -> Bool -> Bool
&& Bool
strict where
  weak :: Bool
weak   = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ forall a. Ord a => [a] -> Bool
isWeaklyIncreasing   [Int]
xs | [Int]
xs <- Tableau Int
t  ]
  strict :: Bool
strict = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ forall a. Ord a => [a] -> Bool
isStrictlyIncreasing [Int]
ys | [Int]
ys <- Tableau Int
dt ]
  dt :: Tableau Int
dt     = forall a. Tableau a -> Tableau a
dualTableau Tableau Int
t
   
-- | Semistandard Young tableaux of given shape, \"naive\" algorithm    
semiStandardYoungTableaux :: Int -> Partition -> [Tableau Int]
semiStandardYoungTableaux :: Int -> Partition -> [Tableau Int]
semiStandardYoungTableaux Int
n Partition
part = [Int] -> [Int] -> [Tableau Int]
worker (forall a. a -> [a]
repeat Int
0) [Int]
shape where
  shape :: [Int]
shape = Partition -> [Int]
fromPartition Partition
part
  worker :: [Int] -> [Int] -> [Tableau Int]
worker [Int]
_ [] = [[]] 
  worker [Int]
prevRow (Int
s:[Int]
ss) 
    = [ ([Int]
rforall a. a -> [a] -> [a]
:Tableau Int
rs) | [Int]
r <- Int -> Int -> Int -> [Int] -> Tableau Int
row Int
n Int
s Int
1 [Int]
prevRow, Tableau Int
rs <- [Int] -> [Int] -> [Tableau Int]
worker (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+Int
1) [Int]
r) [Int]
ss ]

  -- weekly increasing lists of length @len@, pointwise at least @xs@, 
  -- maximum value @n@, minimum value @prev@.
  row :: Int -> Int -> Int -> [Int] -> [[Int]]
  row :: Int -> Int -> Int -> [Int] -> Tableau Int
row Int
_ Int
0   Int
_    [Int]
_      = [[]]
  row Int
n Int
len Int
prev (Int
x:[Int]
xs) = [ (Int
aforall a. a -> [a] -> [a]
:[Int]
as) | Int
a <- [forall a. Ord a => a -> a -> a
max Int
x Int
prev..Int
n] , [Int]
as <- Int -> Int -> Int -> [Int] -> Tableau Int
row Int
n (Int
lenforall a. Num a => a -> a -> a
-Int
1) Int
a [Int]
xs ]

-- | Stanley's hook formula (cf. Fulton page 55)
countSemiStandardYoungTableaux :: Int -> Partition -> Integer
countSemiStandardYoungTableaux :: Int -> Partition -> Integer
countSemiStandardYoungTableaux Int
n Partition
shape = Integer
k forall a. Integral a => a -> a -> a
`div` Integer
h where
  h :: Integer
h = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Partition -> Tableau Int
hookLengths Partition
shape 
  k :: Integer
k = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nforall a. Num a => a -> a -> a
+Int
jforall a. Num a => a -> a -> a
-Int
i) | (Int
i,Int
j) <- Partition -> [(Int, Int)]
elements Partition
shape ]

   
--------------------------------------------------------------------------------
-- * Standard Young tableaux

-- | A tableau is /standard/ if it is semistandard and its content is exactly @[1..n]@,
-- where @n@ is the weight.
isStandardTableau :: Tableau Int -> Bool
isStandardTableau :: Tableau Int -> Bool
isStandardTableau Tableau Int
t = Tableau Int -> Bool
isSemiStandardTableau Tableau Int
t Bool -> Bool -> Bool
&& forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Tableau Int
t) forall a. Eq a => a -> a -> Bool
== [Int
1..Int
n] where
  n :: Int
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs | [Int]
xs <- Tableau Int
t ]

-- | Standard Young tableaux of a given shape.
--   Adapted from John Stembridge, 
--   <http://www.math.lsa.umich.edu/~jrs/software/SFexamples/tableaux>.
standardYoungTableaux :: Partition -> [Tableau Int]
standardYoungTableaux :: Partition -> [Tableau Int]
standardYoungTableaux Partition
shape' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Tableau a -> Tableau a
rev forall a b. (a -> b) -> a -> b
$ [Int] -> [Tableau Int]
tableaux [Int]
shape where
  shape :: [Int]
shape = Partition -> [Int]
fromPartition Partition
shape'
  rev :: [[a]] -> [[a]]
rev = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse
  tableaux :: [Int] -> [Tableau Int]
  tableaux :: [Int] -> [Tableau Int]
tableaux [Int]
p = 
    case [Int]
p of
      []  -> [[]]
      [Int
n] -> [[[Int
n,Int
nforall a. Num a => a -> a -> a
-Int
1..Int
1]]]
      [Int]
_   -> (Int, Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
worker (Int
n,Int
k) Int
0 [] [Int]
p
    where
      n :: Int
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
p
      k :: Int
k = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
p
  worker :: (Int,Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
  worker :: (Int, Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
worker (Int, Int)
_ Int
_ [Int]
_ [] = []
  worker (Int, Int)
nk Int
i [Int]
ls (Int
x:[Int]
rs) = case [Int]
rs of
    (Int
y:[Int]
_) -> if Int
xforall a. Eq a => a -> a -> Bool
==Int
y 
      then (Int, Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
worker (Int, Int)
nk (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
xforall a. a -> [a] -> [a]
:[Int]
ls) [Int]
rs
      else (Int, Int) -> Int -> [Int] -> Int -> [Int] -> [Tableau Int]
worker2 (Int, Int)
nk Int
i [Int]
ls Int
x [Int]
rs
    [] ->  (Int, Int) -> Int -> [Int] -> Int -> [Int] -> [Tableau Int]
worker2 (Int, Int)
nk Int
i [Int]
ls Int
x [Int]
rs
  worker2 :: (Int,Int) -> Int -> [Int] -> Int -> [Int] -> [Tableau Int]
  worker2 :: (Int, Int) -> Int -> [Int] -> Int -> [Int] -> [Tableau Int]
worker2 nk :: (Int, Int)
nk@(Int
n,Int
k) Int
i [Int]
ls Int
x [Int]
rs = [Tableau Int]
new forall a. [a] -> [a] -> [a]
++ (Int, Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
worker (Int, Int)
nk (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
xforall a. a -> [a] -> [a]
:[Int]
ls) [Int]
rs where
    old :: [Tableau Int]
old = if Int
xforall a. Ord a => a -> a -> Bool
>Int
1 
      then             [Int] -> [Tableau Int]
tableaux forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int]
ls forall a. [a] -> [a] -> [a]
++ (Int
xforall a. Num a => a -> a -> a
-Int
1) forall a. a -> [a] -> [a]
: [Int]
rs
      else forall a b. (a -> b) -> [a] -> [b]
map ([]forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [Int] -> [Tableau Int]
tableaux forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int]
ls forall a. [a] -> [a] -> [a]
++ [Int]
rs   
    a :: Int
a = Int
kforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
-Int
i
    new :: [Tableau Int]
new = {- debug ( i , a , head old , f a (head old) ) $ -}
      forall a b. (a -> b) -> [a] -> [b]
map (Int -> Tableau Int -> Tableau Int
f Int
a) [Tableau Int]
old
    f :: Int -> Tableau Int -> Tableau Int
    f :: Int -> Tableau Int -> Tableau Int
f Int
_ [] = []
    f Int
0 ([Int]
t:Tableau Int
ts) = (Int
nforall a. a -> [a] -> [a]
:[Int]
t) forall a. a -> [a] -> [a]
: Int -> Tableau Int -> Tableau Int
f (-Int
1) Tableau Int
ts
    f Int
j ([Int]
t:Tableau Int
ts) = [Int]
t forall a. a -> [a] -> [a]
: Int -> Tableau Int -> Tableau Int
f (Int
jforall a. Num a => a -> a -> a
-Int
1) Tableau Int
ts
  
-- | hook-length formula
countStandardYoungTableaux :: Partition -> Integer
countStandardYoungTableaux :: Partition -> Integer
countStandardYoungTableaux Partition
part = {- debug (hookLengths part) $ -}
  forall a. Integral a => a -> Integer
factorial Int
n forall a. Integral a => a -> a -> a
`div` Integer
h where
    h :: Integer
h = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Partition -> Tableau Int
hookLengths Partition
part 
    n :: Int
n = forall a. HasWeight a => a -> Int
weight Partition
part

--------------------------------------------------------------------------------