{-# 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
type Tableau a = [[a]]
asciiTableau :: Show a => Tableau a -> ASCII
asciiTableau :: 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)
([[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
t
instance CanBeEmpty (Tableau a) where
empty :: Tableau a
empty = []
isEmpty :: Tableau a -> Bool
isEmpty = Tableau a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
instance Show a => DrawASCII (Tableau a) where
ascii :: Tableau a -> ASCII
ascii = Tableau a -> ASCII
forall a. Show a => Tableau a -> ASCII
asciiTableau
_tableauShape :: Tableau a -> [Int]
_tableauShape :: Tableau a -> [Int]
_tableauShape Tableau a
t = ([a] -> Int) -> Tableau a -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tableau a
t
tableauShape :: Tableau a -> Partition
tableauShape :: Tableau a -> Partition
tableauShape Tableau a
t = [Int] -> Partition
toPartition (Tableau a -> [Int]
forall a. Tableau a -> [Int]
_tableauShape Tableau a
t)
instance HasShape (Tableau a) Partition where
shape :: Tableau a -> Partition
shape = Tableau a -> Partition
forall a. Tableau a -> Partition
tableauShape
tableauWeight :: Tableau a -> Int
tableauWeight :: Tableau a -> Int
tableauWeight = [Int] -> Int
forall a. Num a => [a] -> a
sum' ([Int] -> Int) -> (Tableau a -> [Int]) -> Tableau a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int) -> Tableau a -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
instance HasWeight (Tableau a) where
weight :: Tableau a -> Int
weight = Tableau a -> Int
forall a. Tableau a -> Int
tableauWeight
dualTableau :: Tableau a -> Tableau a
dualTableau :: Tableau a -> Tableau a
dualTableau = Tableau a -> Tableau a
forall a. [[a]] -> [[a]]
transpose
instance HasDuality (Tableau a) where
dual :: Tableau a -> Tableau a
dual = Tableau a -> Tableau a
forall a. [[a]] -> [[a]]
dualTableau
tableauContent :: Tableau a -> [a]
tableauContent :: Tableau a -> [a]
tableauContent = Tableau a -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
hooks :: Partition -> Tableau (Int,Int)
hooks :: Partition -> Tableau (Int, Int)
hooks Partition
part = (Int -> Int -> [(Int, Int)])
-> [Int] -> [Int] -> Tableau (Int, Int)
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> [(Int, Int)]
forall a. (Num a, Enum a) => a -> Int -> [(Int, a)]
f [Int]
p [Int
1..] where
p :: [Int]
p = Partition -> [Int]
fromPartition Partition
part
q :: [Int]
q = [Int] -> [Int]
_dualPartition [Int]
p
f :: a -> Int -> [(Int, a)]
f a
l Int
i = (Int -> a -> (Int, a)) -> [Int] -> [a] -> [(Int, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x a
y -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,a
y)) [Int]
q [a
l,a
la -> a -> a
forall a. Num a => a -> a -> a
-a
1..a
1]
hookLengths :: Partition -> Tableau Int
hookLengths :: Partition -> Tableau Int
hookLengths Partition
part = (([(Int, Int)] -> [Int]) -> Tableau (Int, Int) -> Tableau Int
forall a b. (a -> b) -> [a] -> [b]
map (([(Int, Int)] -> [Int]) -> Tableau (Int, Int) -> Tableau Int)
-> (((Int, Int) -> Int) -> [(Int, Int)] -> [Int])
-> ((Int, Int) -> Int)
-> Tableau (Int, Int)
-> Tableau Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map) (\(Int
i,Int
j) -> Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Partition -> Tableau (Int, Int)
hooks Partition
part)
rowWord :: Tableau a -> [a]
rowWord :: Tableau a -> [a]
rowWord = Tableau a -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Tableau a -> [a]) -> (Tableau a -> Tableau a) -> Tableau a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tableau a -> Tableau a
forall a. [a] -> [a]
reverse
rowWordToTableau :: Ord a => [a] -> Tableau a
rowWordToTableau :: [a] -> Tableau a
rowWordToTableau [a]
xs = Tableau a -> Tableau a
forall a. [a] -> [a]
reverse Tableau a
rows where
rows :: Tableau a
rows = [a] -> Tableau a
forall a. Ord a => [a] -> [[a]]
break [a]
xs
break :: [a] -> [[a]]
break [] = [[]]
break [a
x] = [[a
x]]
break (a
x:xs :: [a]
xs@(a
y:[a]
_)) = if a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
y
then [a
x] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
break [a]
xs
else let ([a]
h:[[a]]
t) = [a] -> [[a]]
break [a]
xs in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
h)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
t
columnWord :: Tableau a -> [a]
columnWord :: Tableau a -> [a]
columnWord = Tableau a -> [a]
forall a. Tableau a -> [a]
rowWord (Tableau a -> [a]) -> (Tableau a -> Tableau a) -> Tableau a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tableau a -> Tableau a
forall a. [[a]] -> [[a]]
transpose
columnWordToTableau :: Ord a => [a] -> Tableau a
columnWordToTableau :: [a] -> Tableau a
columnWordToTableau = Tableau a -> Tableau a
forall a. [[a]] -> [[a]]
transpose (Tableau a -> Tableau a) -> ([a] -> Tableau a) -> [a] -> Tableau a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Tableau a
forall a. Ord a => [a] -> [[a]]
rowWordToTableau
isLatticeWord :: [Int] -> Bool
isLatticeWord :: [Int] -> Bool
isLatticeWord = Map Int Int -> [Int] -> Bool
go Map Int Int
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' = (Int -> Int -> Int) -> Int -> Int -> Map Int Int -> Map Int Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
i Int
1 Map Int Int
table
check :: Int -> Bool
check Int
j = Int
jInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
|| Int -> Int
cnt (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
cnt Int
j
cnt :: Int -> Int
cnt Int
j = case Int -> Map Int Int -> Maybe Int
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
isSemiStandardTableau :: Tableau Int -> Bool
isSemiStandardTableau :: Tableau Int -> Bool
isSemiStandardTableau Tableau Int
t = Bool
weak Bool -> Bool -> Bool
&& Bool
strict where
weak :: Bool
weak = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [Int] -> Bool
forall a. Ord a => [a] -> Bool
isWeaklyIncreasing [Int]
xs | [Int]
xs <- Tableau Int
t ]
strict :: Bool
strict = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [Int] -> Bool
forall a. Ord a => [a] -> Bool
isStrictlyIncreasing [Int]
ys | [Int]
ys <- Tableau Int
dt ]
dt :: Tableau Int
dt = Tableau Int -> Tableau Int
forall a. [[a]] -> [[a]]
dualTableau Tableau Int
t
semiStandardYoungTableaux :: Int -> Partition -> [Tableau Int]
semiStandardYoungTableaux :: Int -> Partition -> [Tableau Int]
semiStandardYoungTableaux Int
n Partition
part = [Int] -> [Int] -> [Tableau Int]
worker (Int -> [Int]
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]
r[Int] -> Tableau Int -> Tableau Int
forall 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 ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
r) [Int]
ss ]
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
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
as) | Int
a <- [Int -> Int -> Int
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
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
a [Int]
xs ]
countSemiStandardYoungTableaux :: Int -> Partition -> Integer
countSemiStandardYoungTableaux :: Int -> Partition -> Integer
countSemiStandardYoungTableaux Int
n Partition
shape = Integer
k Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
h where
h :: Integer
h = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Integer]) -> [Int] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Tableau Int -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Tableau Int -> [Int]) -> Tableau Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Partition -> Tableau Int
hookLengths Partition
shape
k :: Integer
k = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | (Int
i,Int
j) <- Partition -> [(Int, Int)]
elements Partition
shape ]
isStandardTableau :: Tableau Int -> Bool
isStandardTableau :: Tableau Int -> Bool
isStandardTableau Tableau Int
t = Tableau Int -> Bool
isSemiStandardTableau Tableau Int
t Bool -> Bool -> Bool
&& [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort (Tableau Int -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Tableau Int
t) [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
1..Int
n] where
n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs | [Int]
xs <- Tableau Int
t ]
standardYoungTableaux :: Partition -> [Tableau Int]
standardYoungTableaux :: Partition -> [Tableau Int]
standardYoungTableaux Partition
shape' = (Tableau Int -> Tableau Int) -> [Tableau Int] -> [Tableau Int]
forall a b. (a -> b) -> [a] -> [b]
map Tableau Int -> Tableau Int
forall a. [[a]] -> [[a]]
rev ([Tableau Int] -> [Tableau Int]) -> [Tableau Int] -> [Tableau Int]
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 = [[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
tableaux :: [Int] -> [Tableau Int]
tableaux :: [Int] -> [Tableau Int]
tableaux [Int]
p =
case [Int]
p of
[] -> [[]]
[Int
n] -> [[[Int
n,Int
nInt -> Int -> Int
forall 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 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
p
k :: Int
k = [Int] -> Int
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
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y
then (Int, Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
worker (Int, Int)
nk (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
xInt -> [Int] -> [Int]
forall 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 [Tableau Int] -> [Tableau Int] -> [Tableau Int]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
worker (Int, Int)
nk (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ls) [Int]
rs where
old :: [Tableau Int]
old = if Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1
then [Int] -> [Tableau Int]
tableaux ([Int] -> [Tableau Int]) -> [Int] -> [Tableau Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
ls [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
rs
else (Tableau Int -> Tableau Int) -> [Tableau Int] -> [Tableau Int]
forall a b. (a -> b) -> [a] -> [b]
map ([][Int] -> Tableau Int -> Tableau Int
forall a. a -> [a] -> [a]
:) ([Tableau Int] -> [Tableau Int]) -> [Tableau Int] -> [Tableau Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Tableau Int]
tableaux ([Int] -> [Tableau Int]) -> [Int] -> [Tableau Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
ls [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
rs
a :: Int
a = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i
new :: [Tableau Int]
new =
(Tableau Int -> Tableau Int) -> [Tableau Int] -> [Tableau Int]
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
nInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
t) [Int] -> Tableau Int -> Tableau Int
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 [Int] -> Tableau Int -> Tableau Int
forall a. a -> [a] -> [a]
: Int -> Tableau Int -> Tableau Int
f (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tableau Int
ts
countStandardYoungTableaux :: Partition -> Integer
countStandardYoungTableaux :: Partition -> Integer
countStandardYoungTableaux Partition
part =
Int -> Integer
forall a. Integral a => a -> Integer
factorial Int
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
h where
h :: Integer
h = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Integer]) -> [Int] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Tableau Int -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Tableau Int -> [Int]) -> Tableau Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Partition -> Tableau Int
hookLengths Partition
part
n :: Int
n = Partition -> Int
forall a. HasWeight a => a -> Int
weight Partition
part