-- TODO: better name?

-- | This module contains a function to generate (equivalence classes of) 
-- triangular tableaux of size /k/, strictly increasing to the right and 
-- to the bottom. For example
-- 
-- >  1  
-- >  2  4  
-- >  3  5  8  
-- >  6  7  9  10 
--
-- is such a tableau of size 4.
-- The numbers filling a tableau always consist of an interval @[1..c]@;
-- @c@ is called the /content/ of the tableaux. There is a unique tableau
-- of minimal content @2k-1@:
--
-- >  1  
-- >  2  3  
-- >  3  4  5 
-- >  4  5  6  7 
-- 
-- Let us call the tableaux with maximal content (that is, @m = binomial (k+1) 2@)
-- /standard/. The number of such standard tableaux are
--
-- > 1, 1, 2, 12, 286, 33592, 23178480, ...
--
-- OEIS:A003121, \"Strict sense ballot numbers\", 
-- <https://oeis.org/A003121>.
--
-- See 
-- R. M. Thrall, A combinatorial problem, Michigan Math. J. 1, (1952), 81-88.
-- 
-- The number of tableaux with content @c=m-d@ are
-- 
-- >  d=  |     0      1      2      3    ...
-- > -----+----------------------------------------------
-- >  k=2 |     1
-- >  k=3 |     2      1
-- >  k=4 |    12     18      8      1
-- >  k=5 |   286    858   1001    572    165     22     1
-- >  k=6 | 33592 167960 361114 436696 326196 155584 47320 8892 962 52 1 
--
-- We call these \"GT simplex tableaux\" (in the lack of a better name), since
-- they are in bijection with the simplicial cones in a canonical simplicial 
-- decompositions of the Gelfand-Tsetlin cones (the content corresponds
-- to the dimension), which encode the combinatorics of Kostka numbers.
--

{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
module Math.Combinat.Tableaux.GelfandTsetlin.Cone
  ( 
    -- * Types
    Tableau
  , Tri(..)
  , TriangularArray
  , fromTriangularArray
  , triangularArrayUnsafe
    -- * ASCII
  , asciiTriangularArray
  , asciiTableau
    -- * Content
  , gtSimplexContent
  , _gtSimplexContent
  , invertGTSimplexTableau
  , _invertGTSimplexTableau
    -- * Enumeration
  , gtSimplexTableaux
  , _gtSimplexTableaux
  , countGTSimplexTableaux
  ) 
  where

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

import Data.Ix
import Data.Ord
import Data.List

import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.Unboxed
import Data.Array.ST

import Math.Combinat.Tableaux (Tableau)
import Math.Combinat.Helper
import Math.Combinat.ASCII

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

-- | Triangular arrays
type TriangularArray a = Array Tri a

-- | Set of @(i,j)@ pairs with @i>=j>=1@.
newtype Tri = Tri { Tri -> (Int, Int)
unTri :: (Int,Int) } deriving (Tri -> Tri -> Bool
(Tri -> Tri -> Bool) -> (Tri -> Tri -> Bool) -> Eq Tri
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tri -> Tri -> Bool
$c/= :: Tri -> Tri -> Bool
== :: Tri -> Tri -> Bool
$c== :: Tri -> Tri -> Bool
Eq,Eq Tri
Eq Tri
-> (Tri -> Tri -> Ordering)
-> (Tri -> Tri -> Bool)
-> (Tri -> Tri -> Bool)
-> (Tri -> Tri -> Bool)
-> (Tri -> Tri -> Bool)
-> (Tri -> Tri -> Tri)
-> (Tri -> Tri -> Tri)
-> Ord Tri
Tri -> Tri -> Bool
Tri -> Tri -> Ordering
Tri -> Tri -> Tri
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tri -> Tri -> Tri
$cmin :: Tri -> Tri -> Tri
max :: Tri -> Tri -> Tri
$cmax :: Tri -> Tri -> Tri
>= :: Tri -> Tri -> Bool
$c>= :: Tri -> Tri -> Bool
> :: Tri -> Tri -> Bool
$c> :: Tri -> Tri -> Bool
<= :: Tri -> Tri -> Bool
$c<= :: Tri -> Tri -> Bool
< :: Tri -> Tri -> Bool
$c< :: Tri -> Tri -> Bool
compare :: Tri -> Tri -> Ordering
$ccompare :: Tri -> Tri -> Ordering
$cp1Ord :: Eq Tri
Ord,Int -> Tri -> ShowS
[Tri] -> ShowS
Tri -> String
(Int -> Tri -> ShowS)
-> (Tri -> String) -> ([Tri] -> ShowS) -> Show Tri
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tri] -> ShowS
$cshowList :: [Tri] -> ShowS
show :: Tri -> String
$cshow :: Tri -> String
showsPrec :: Int -> Tri -> ShowS
$cshowsPrec :: Int -> Tri -> ShowS
Show)

binom2 :: Int -> Int
binom2 :: Int -> Int
binom2 Int
n = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

index' :: Tri -> Int
index' :: Tri -> Int
index' (Tri (Int
i,Int
j)) = Int -> Int
binom2 Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- it should be (1+8*m), 
-- the 2 is a hack to be safe with the floating point stuff
deIndex' :: Int -> Tri 
deIndex' :: Int -> Tri
deIndex' Int
m = (Int, Int) -> Tri
Tri ( Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 , Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
binom2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 ) where
  i :: Int
i = ( (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor(Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Double -> Double
forall a. Floating a => a -> a
sqrt(Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral::Int->Double)) (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2  

instance Ix Tri where
  index :: (Tri, Tri) -> Tri -> Int
index   (Tri
a,Tri
b) Tri
x = Tri -> Int
index' Tri
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tri -> Int
index' Tri
a 
  inRange :: (Tri, Tri) -> Tri -> Bool
inRange (Tri
a,Tri
b) Tri
x = (Int
uInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
j Bool -> Bool -> Bool
&& Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
v) where
    u :: Int
u = Tri -> Int
index' Tri
a 
    v :: Int
v = Tri -> Int
index' Tri
b
    j :: Int
j = Tri -> Int
index' Tri
x
  range :: (Tri, Tri) -> [Tri]
range     (Tri
a,Tri
b) = (Int -> Tri) -> [Int] -> [Tri]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Tri
deIndex' [ Tri -> Int
index' Tri
a .. Tri -> Int
index' Tri
b ] 
  rangeSize :: (Tri, Tri) -> Int
rangeSize (Tri
a,Tri
b) = Tri -> Int
index' Tri
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tri -> Int
index' Tri
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 

triangularArrayUnsafe :: Tableau a -> TriangularArray a
triangularArrayUnsafe :: Tableau a -> TriangularArray a
triangularArrayUnsafe Tableau a
tableau = (Tri, Tri) -> [a] -> TriangularArray a
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray ((Int, Int) -> Tri
Tri (Int
1,Int
1),(Int, Int) -> Tri
Tri (Int
k,Int
k)) (Tableau a -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Tableau a
tableau) 
  where k :: Int
k = Tableau a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tableau a
tableau

fromTriangularArray :: TriangularArray a -> Tableau a
fromTriangularArray :: TriangularArray a -> Tableau a
fromTriangularArray TriangularArray a
arr = (([(Tri, a)] -> [a]) -> [[(Tri, a)]] -> Tableau a
forall a b. (a -> b) -> [a] -> [b]
map(([(Tri, a)] -> [a]) -> [[(Tri, a)]] -> Tableau a)
-> (((Tri, a) -> a) -> [(Tri, a)] -> [a])
-> ((Tri, a) -> a)
-> [[(Tri, a)]]
-> Tableau a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Tri, a) -> a) -> [(Tri, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map) (Tri, a) -> a
forall a b. (a, b) -> b
snd ([[(Tri, a)]] -> Tableau a) -> [[(Tri, a)]] -> Tableau a
forall a b. (a -> b) -> a -> b
$ ((Tri, a) -> (Tri, a) -> Bool) -> [(Tri, a)] -> [[(Tri, a)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (((Tri, a) -> Int) -> (Tri, a) -> (Tri, a) -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating (Tri, a) -> Int
forall b. (Tri, b) -> Int
f) ([(Tri, a)] -> [[(Tri, a)]]) -> [(Tri, a)] -> [[(Tri, a)]]
forall a b. (a -> b) -> a -> b
$ TriangularArray a -> [(Tri, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs TriangularArray a
arr
  where f :: (Tri, b) -> Int
f = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> ((Tri, b) -> (Int, Int)) -> (Tri, b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tri -> (Int, Int)
unTri (Tri -> (Int, Int)) -> ((Tri, b) -> Tri) -> (Tri, b) -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tri, b) -> Tri
forall a b. (a, b) -> a
fst

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

asciiTriangularArray :: Show a => TriangularArray a -> ASCII
asciiTriangularArray :: TriangularArray a -> ASCII
asciiTriangularArray = Tableau a -> ASCII
forall a. Show a => Tableau a -> ASCII
asciiTableau (Tableau a -> ASCII)
-> (TriangularArray a -> Tableau a) -> TriangularArray a -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriangularArray a -> Tableau a
forall a. TriangularArray a -> Tableau a
fromTriangularArray

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

instance Show a => DrawASCII (TriangularArray a) where
  ascii :: TriangularArray a -> ASCII
ascii = TriangularArray a -> ASCII
forall a. Show a => TriangularArray a -> ASCII
asciiTriangularArray

-- instance Show a => DrawASCII (Tableau a) where
--   ascii = asciiTableau

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

-- "fractional fillings"
data Hole = Hole Int Int deriving (Hole -> Hole -> Bool
(Hole -> Hole -> Bool) -> (Hole -> Hole -> Bool) -> Eq Hole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hole -> Hole -> Bool
$c/= :: Hole -> Hole -> Bool
== :: Hole -> Hole -> Bool
$c== :: Hole -> Hole -> Bool
Eq,Eq Hole
Eq Hole
-> (Hole -> Hole -> Ordering)
-> (Hole -> Hole -> Bool)
-> (Hole -> Hole -> Bool)
-> (Hole -> Hole -> Bool)
-> (Hole -> Hole -> Bool)
-> (Hole -> Hole -> Hole)
-> (Hole -> Hole -> Hole)
-> Ord Hole
Hole -> Hole -> Bool
Hole -> Hole -> Ordering
Hole -> Hole -> Hole
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hole -> Hole -> Hole
$cmin :: Hole -> Hole -> Hole
max :: Hole -> Hole -> Hole
$cmax :: Hole -> Hole -> Hole
>= :: Hole -> Hole -> Bool
$c>= :: Hole -> Hole -> Bool
> :: Hole -> Hole -> Bool
$c> :: Hole -> Hole -> Bool
<= :: Hole -> Hole -> Bool
$c<= :: Hole -> Hole -> Bool
< :: Hole -> Hole -> Bool
$c< :: Hole -> Hole -> Bool
compare :: Hole -> Hole -> Ordering
$ccompare :: Hole -> Hole -> Ordering
$cp1Ord :: Eq Hole
Ord,Int -> Hole -> ShowS
[Hole] -> ShowS
Hole -> String
(Int -> Hole -> ShowS)
-> (Hole -> String) -> ([Hole] -> ShowS) -> Show Hole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hole] -> ShowS
$cshowList :: [Hole] -> ShowS
show :: Hole -> String
$cshow :: Hole -> String
showsPrec :: Int -> Hole -> ShowS
$cshowsPrec :: Int -> Hole -> ShowS
Show)

type ReverseTableau      = [[Int ]] 
type ReverseHoleTableau  = [[Hole]]      

toHole :: Int -> Hole
toHole :: Int -> Hole
toHole Int
k = Int -> Int -> Hole
Hole Int
k Int
0

nextHole :: Hole -> Hole
nextHole :: Hole -> Hole
nextHole (Hole Int
k Int
l) = Int -> Int -> Hole
Hole Int
k (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

reverseTableau :: [[a]] -> [[a]]
reverseTableau :: [[a]] -> [[a]]
reverseTableau = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse

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

gtSimplexContent :: TriangularArray Int -> Int
gtSimplexContent :: TriangularArray Int -> Int
gtSimplexContent TriangularArray Int
arr = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (TriangularArray Int
arr TriangularArray Int -> Tri -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((Tri, Tri) -> Tri
forall a b. (a, b) -> a
fst (TriangularArray Int -> (Tri, Tri)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds TriangularArray Int
arr))) (TriangularArray Int
arr TriangularArray Int -> Tri -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((Tri, Tri) -> Tri
forall a b. (a, b) -> b
snd (TriangularArray Int -> (Tri, Tri)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds TriangularArray Int
arr)))   -- we also handle inverted tableau

_gtSimplexContent :: Tableau Int -> Int
_gtSimplexContent :: Tableau Int -> Int
_gtSimplexContent Tableau Int
t = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Tableau Int -> [Int]
forall a. [a] -> a
head Tableau Int
t) ([Int] -> Int
forall a. [a] -> a
last ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Tableau Int -> [Int]
forall a. [a] -> a
last Tableau Int
t)   -- we also handle inverted tableau
 
normalize :: ReverseHoleTableau -> TriangularArray Int 
normalize :: ReverseHoleTableau -> TriangularArray Int
normalize = (Int, TriangularArray Int) -> TriangularArray Int
forall a b. (a, b) -> b
snd ((Int, TriangularArray Int) -> TriangularArray Int)
-> (ReverseHoleTableau -> (Int, TriangularArray Int))
-> ReverseHoleTableau
-> TriangularArray Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReverseHoleTableau -> (Int, TriangularArray Int)
normalize'

-- returns ( content , tableau )
normalize' :: ReverseHoleTableau -> ( Int , TriangularArray Int )   
normalize' :: ReverseHoleTableau -> (Int, TriangularArray Int)
normalize' ReverseHoleTableau
holes = ( Int
c , (Tri, Tri) -> [(Tri, Int)] -> TriangularArray Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array ((Int, Int) -> Tri
Tri (Int
1,Int
1), (Int, Int) -> Tri
Tri (Int
k,Int
k)) [(Tri, Int)]
xys ) where
  k :: Int
k = ReverseHoleTableau -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ReverseHoleTableau
holes
  c :: Int
c = [[((Int, Int), Hole)]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[((Int, Int), Hole)]]
sorted
  xys :: [(Tri, Int)]
xys = [[(Tri, Int)]] -> [(Tri, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Tri, Int)]] -> [(Tri, Int)]) -> [[(Tri, Int)]] -> [(Tri, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> [((Int, Int), Hole)] -> [(Tri, Int)])
-> [Int] -> [[((Int, Int), Hole)]] -> [[(Tri, Int)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [((Int, Int), Hole)] -> [(Tri, Int)]
forall b b. b -> [((Int, Int), b)] -> [(Tri, b)]
hs [Int
1..] [[((Int, Int), Hole)]]
sorted
  hs :: b -> [((Int, Int), b)] -> [(Tri, b)]
hs b
a [((Int, Int), b)]
xs     = (((Int, Int), b) -> (Tri, b)) -> [((Int, Int), b)] -> [(Tri, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b -> ((Int, Int), b) -> (Tri, b)
forall b b. b -> ((Int, Int), b) -> (Tri, b)
h b
a) [((Int, Int), b)]
xs
  h :: b -> ((Int, Int), b) -> (Tri, b)
h  b
a ((Int, Int)
ij,b
_) = ((Int, Int) -> Tri
Tri (Int, Int)
ij , b
a)  
  sorted :: [[((Int, Int), Hole)]]
sorted = (((Int, Int), Hole) -> Hole)
-> [((Int, Int), Hole)] -> [[((Int, Int), Hole)]]
forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
groupSortBy ((Int, Int), Hole) -> Hole
forall a b. (a, b) -> b
snd ([[((Int, Int), Hole)]] -> [((Int, Int), Hole)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((Int, Int), Hole)]]
withPos)
  withPos :: [[((Int, Int), Hole)]]
withPos = (Int -> [Hole] -> [((Int, Int), Hole)])
-> [Int] -> ReverseHoleTableau -> [[((Int, Int), Hole)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Hole] -> [((Int, Int), Hole)]
forall b a b. (Num b, Enum b) => a -> [b] -> [((a, b), b)]
f [Int
1..] (ReverseHoleTableau -> ReverseHoleTableau
forall a. [[a]] -> [[a]]
reverseTableau ReverseHoleTableau
holes) 
  f :: a -> [b] -> [((a, b), b)]
f a
i [b]
xs = (b -> b -> ((a, b), b)) -> [b] -> [b] -> [((a, b), b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> b -> b -> ((a, b), b)
forall a b b. a -> b -> b -> ((a, b), b)
g a
i) [b
1..] [b]
xs 
  g :: a -> b -> b -> ((a, b), b)
g a
i b
j b
hole = ((a
i,b
j),b
hole) 

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

startHole :: [Hole] -> [Int] -> Hole 
startHole :: [Hole] -> [Int] -> Hole
startHole (Hole
t:[Hole]
ts) (Int
p:[Int]
ps) = Hole -> Hole -> Hole
forall a. Ord a => a -> a -> a
max Hole
t (Int -> Hole
toHole Int
p)
startHole (Hole
t:[Hole]
ts) []     = Hole
t
startHole []     (Int
p:[Int]
ps) = Int -> Hole
toHole Int
p
startHole []     []     = String -> Hole
forall a. HasCallStack => String -> a
error String
"startHole"

-- c is the "content" of the small tableau
enumHoles :: Int -> Hole -> [Hole]
enumHoles :: Int -> Hole -> [Hole]
enumHoles Int
c start :: Hole
start@(Hole Int
k Int
l) 
  = Hole -> Hole
nextHole Hole
start 
  Hole -> [Hole] -> [Hole]
forall a. a -> [a] -> [a]
: [ Int -> Int -> Hole
Hole Int
i Int
0 | Int
i <- [Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
c] ] [Hole] -> [Hole] -> [Hole]
forall a. [a] -> [a] -> [a]
++ [ Int -> Int -> Hole
Hole Int
i Int
1 | Int
i <- [Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
c] ]

helper :: Int -> [Int] -> [Hole] -> [[Hole]]
helper :: Int -> [Int] -> [Hole] -> ReverseHoleTableau
helper Int
c [] [Hole]
this = [[]] 
helper Int
c prev :: [Int]
prev@(Int
p:[Int]
ps) [Hole]
this = 
  [ Hole
tHole -> [Hole] -> [Hole]
forall a. a -> [a] -> [a]
:[Hole]
rest | Hole
t <- Int -> Hole -> [Hole]
enumHoles Int
c ([Hole] -> [Int] -> Hole
startHole [Hole]
this [Int]
prev), [Hole]
rest <- Int -> [Int] -> [Hole] -> ReverseHoleTableau
helper Int
c [Int]
ps (Hole
tHole -> [Hole] -> [Hole]
forall a. a -> [a] -> [a]
:[Hole]
this) ]

newLines' :: Int -> [Int] -> [[Hole]]
newLines' :: Int -> [Int] -> ReverseHoleTableau
newLines' Int
c [Int]
lastReversed = Int -> [Int] -> [Hole] -> ReverseHoleTableau
helper Int
c [Int]
last []  
  where
    top :: Int
top  = [Int] -> Int
forall a. [a] -> a
head [Int]
lastReversed
    last :: [Int]
last = [Int] -> [Int]
forall a. [a] -> [a]
reverse (Int
top Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
lastReversed)

newLines :: [Int] -> [[Hole]]
newLines :: [Int] -> ReverseHoleTableau
newLines [Int]
lastReversed = Int -> [Int] -> ReverseHoleTableau
newLines' ([Int] -> Int
forall a. [a] -> a
head [Int]
lastReversed) [Int]
lastReversed

-- | Generates all tableaux of size @k@. Effective for @k<=6@.
gtSimplexTableaux :: Int -> [TriangularArray Int]
gtSimplexTableaux :: Int -> [TriangularArray Int]
gtSimplexTableaux Int
0 = [ Tableau Int -> TriangularArray Int
forall a. Tableau a -> TriangularArray a
triangularArrayUnsafe [] ]
gtSimplexTableaux Int
1 = [ Tableau Int -> TriangularArray Int
forall a. Tableau a -> TriangularArray a
triangularArrayUnsafe [[Int
1]] ]
gtSimplexTableaux Int
k = (ReverseHoleTableau -> TriangularArray Int)
-> [ReverseHoleTableau] -> [TriangularArray Int]
forall a b. (a -> b) -> [a] -> [b]
map ReverseHoleTableau -> TriangularArray Int
normalize ([ReverseHoleTableau] -> [TriangularArray Int])
-> [ReverseHoleTableau] -> [TriangularArray Int]
forall a b. (a -> b) -> a -> b
$ (Tableau Int -> [ReverseHoleTableau])
-> [Tableau Int] -> [ReverseHoleTableau]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tableau Int -> [ReverseHoleTableau]
f [Tableau Int]
smalls where
  smalls :: [ [[Int]] ]
  smalls :: [Tableau Int]
smalls = (TriangularArray Int -> Tableau Int)
-> [TriangularArray Int] -> [Tableau Int]
forall a b. (a -> b) -> [a] -> [b]
map (Tableau Int -> Tableau Int
forall a. [[a]] -> [[a]]
reverseTableau (Tableau Int -> Tableau Int)
-> (TriangularArray Int -> Tableau Int)
-> TriangularArray Int
-> Tableau Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriangularArray Int -> Tableau Int
forall a. TriangularArray a -> Tableau a
fromTriangularArray) ([TriangularArray Int] -> [Tableau Int])
-> [TriangularArray Int] -> [Tableau Int]
forall a b. (a -> b) -> a -> b
$ Int -> [TriangularArray Int]
gtSimplexTableaux (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  f :: [[Int]] -> [ [[Hole]] ]
  f :: Tableau Int -> [ReverseHoleTableau]
f Tableau Int
small = ([Hole] -> ReverseHoleTableau)
-> ReverseHoleTableau -> [ReverseHoleTableau]
forall a b. (a -> b) -> [a] -> [b]
map ([Hole] -> ReverseHoleTableau -> ReverseHoleTableau
forall a. a -> [a] -> [a]
:ReverseHoleTableau
smallhole) (ReverseHoleTableau -> [ReverseHoleTableau])
-> ReverseHoleTableau -> [ReverseHoleTableau]
forall a b. (a -> b) -> a -> b
$ ([Hole] -> [Hole]) -> ReverseHoleTableau -> ReverseHoleTableau
forall a b. (a -> b) -> [a] -> [b]
map [Hole] -> [Hole]
forall a. [a] -> [a]
reverse (ReverseHoleTableau -> ReverseHoleTableau)
-> ReverseHoleTableau -> ReverseHoleTableau
forall a b. (a -> b) -> a -> b
$ [Int] -> ReverseHoleTableau
newLines (Tableau Int -> [Int]
forall a. [a] -> a
head Tableau Int
small) where
    smallhole :: ReverseHoleTableau
smallhole = ([Int] -> [Hole]) -> Tableau Int -> ReverseHoleTableau
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Hole) -> [Int] -> [Hole]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Hole
toHole) Tableau Int
small

_gtSimplexTableaux :: Int -> [Tableau Int]
_gtSimplexTableaux :: Int -> [Tableau Int]
_gtSimplexTableaux Int
k = (TriangularArray Int -> Tableau Int)
-> [TriangularArray Int] -> [Tableau Int]
forall a b. (a -> b) -> [a] -> [b]
map TriangularArray Int -> Tableau Int
forall a. TriangularArray a -> Tableau a
fromTriangularArray ([TriangularArray Int] -> [Tableau Int])
-> [TriangularArray Int] -> [Tableau Int]
forall a b. (a -> b) -> a -> b
$ Int -> [TriangularArray Int]
gtSimplexTableaux Int
k

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

-- | Note: This is slow (it actually generates all the tableaux)
countGTSimplexTableaux :: Int -> [Int]
countGTSimplexTableaux :: Int -> [Int]
countGTSimplexTableaux = UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems (UArray Int Int -> [Int])
-> (Int -> UArray Int Int) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UArray Int Int
sizes'

sizes' :: Int -> UArray Int Int
sizes' :: Int -> UArray Int Int
sizes' Int
k = 
  (forall s. ST s (STUArray s Int Int)) -> UArray Int Int
forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray ((forall s. ST s (STUArray s Int Int)) -> UArray Int Int)
-> (forall s. ST s (STUArray s Int Int)) -> UArray Int Int
forall a b. (a -> b) -> a -> b
$ do
    let (Int
a,Int
b) = ( Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 , Int -> Int
binom2 (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) )
    STUArray s Int Int
ar <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
a,Int
b) Int
0 :: ST s (STUArray s Int Int)   
    (TriangularArray Int -> ST s ())
-> [TriangularArray Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (STUArray s Int Int -> TriangularArray Int -> ST s ()
forall s. STUArray s Int Int -> TriangularArray Int -> ST s ()
worker STUArray s Int Int
ar) ([TriangularArray Int] -> ST s ())
-> [TriangularArray Int] -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> [TriangularArray Int]
gtSimplexTableaux Int
k 
    STUArray s Int Int -> ST s (STUArray s Int Int)
forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Int
ar
  where
    worker :: STUArray s Int Int -> TriangularArray Int -> ST s ()
    worker :: STUArray s Int Int -> TriangularArray Int -> ST s ()
worker STUArray s Int Int
ar TriangularArray Int
t = do
      let c :: Int
c = TriangularArray Int -> Int
gtSimplexContent TriangularArray Int
t 
      Int
n <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
ar Int
c  
      STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
ar Int
c (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
     
--------------------------------------------------------------------------------

-- | We can flip the numbers in the tableau so that the interval @[1..c]@ becomes
-- @[c..1]@. This way we a get a maybe more familiar form, when each row and each
-- column is strictly /decreasing/ (to the right and to the bottom).
invertGTSimplexTableau :: TriangularArray Int -> TriangularArray Int 
invertGTSimplexTableau :: TriangularArray Int -> TriangularArray Int
invertGTSimplexTableau TriangularArray Int
t = (Int -> Int) -> TriangularArray Int -> TriangularArray Int
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
amap Int -> Int
f TriangularArray Int
t where
  c :: Int
c = TriangularArray Int -> Int
gtSimplexContent TriangularArray Int
t 
  f :: Int -> Int
f Int
x = Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x  

_invertGTSimplexTableau :: [[Int]] -> [[Int]]
_invertGTSimplexTableau :: Tableau Int -> Tableau Int
_invertGTSimplexTableau Tableau Int
t = (([Int] -> [Int]) -> Tableau Int -> Tableau Int
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> [Int]) -> Tableau Int -> Tableau Int)
-> ((Int -> Int) -> [Int] -> [Int])
-> (Int -> Int)
-> Tableau Int
-> Tableau Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map) Int -> Int
f Tableau Int
t where
  c :: Int
c = Tableau Int -> Int
_gtSimplexContent Tableau Int
t  
  f :: Int -> Int
f Int
x = Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x

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