{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
module Math.Combinat.Tableaux.GelfandTsetlin.Cone
(
Tableau
, Tri(..)
, TriangularArray
, fromTriangularArray
, triangularArrayUnsafe
, asciiTriangularArray
, asciiTableau
, gtSimplexContent
, _gtSimplexContent
, invertGTSimplexTableau
, _invertGTSimplexTableau
, 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
type TriangularArray a = Array Tri a
newtype Tri = Tri { Tri -> (Int, Int)
unTri :: (Int,Int) } deriving (Tri -> Tri -> Bool
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
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
Ord,Int -> Tri -> ShowS
[Tri] -> ShowS
Tri -> String
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
nforall a. Num a => a -> a -> a
*(Int
nforall a. Num a => a -> a -> a
-Int
1)) 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 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
- Int
1
deIndex' :: Int -> Tri
deIndex' :: Int -> Tri
deIndex' Int
m = (Int, Int) -> Tri
Tri ( Int
iforall a. Num a => a -> a -> a
+Int
1 , Int
m forall a. Num a => a -> a -> a
- Int -> Int
binom2 (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Num a => a -> a -> a
+ Int
1 ) where
i :: Int
i = ( (forall a b. (RealFrac a, Integral b) => a -> b
floorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Floating a => a -> a
sqrtforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a b. (Integral a, Num b) => a -> b
fromIntegral::Int->Double)) (Int
2forall a. Num a => a -> a -> a
+Int
8forall a. Num a => a -> a -> a
*Int
m) forall a. Num a => a -> a -> a
- Int
1 ) 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 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
uforall a. Ord a => a -> a -> Bool
<=Int
j Bool -> Bool -> Bool
&& Int
jforall 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) = 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 forall a. Num a => a -> a -> a
- Tri -> Int
index' Tri
a forall a. Num a => a -> a -> a
+ Int
1
triangularArrayUnsafe :: Tableau a -> TriangularArray a
triangularArrayUnsafe :: forall a. Tableau a -> TriangularArray a
triangularArrayUnsafe Tableau a
tableau = 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)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Tableau a
tableau)
where k :: Int
k = forall (t :: * -> *) a. Foldable t => t a -> Int
length Tableau a
tableau
fromTriangularArray :: TriangularArray a -> Tableau a
fromTriangularArray :: forall a. TriangularArray a -> Tableau a
fromTriangularArray TriangularArray a
arr = (forall a b. (a -> b) -> [a] -> [b]
mapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map) forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating forall {b}. (Tri, b) -> Int
f) forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs TriangularArray a
arr
where f :: (Tri, b) -> Int
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tri -> (Int, Int)
unTri forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
asciiTriangularArray :: Show a => TriangularArray a -> ASCII
asciiTriangularArray :: forall a. Show a => TriangularArray a -> ASCII
asciiTriangularArray = forall a. Show a => Tableau a -> ASCII
asciiTableau forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TriangularArray a -> Tableau a
fromTriangularArray
asciiTableau :: Show a => Tableau a -> ASCII
asciiTableau :: forall a. Show a => 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)
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
xxs
instance Show a => DrawASCII (TriangularArray a) where
ascii :: TriangularArray a -> ASCII
ascii = forall a. Show a => TriangularArray a -> ASCII
asciiTriangularArray
data Hole = Hole Int Int deriving (Hole -> Hole -> Bool
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
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
Ord,Int -> Hole -> ShowS
[Hole] -> ShowS
Hole -> String
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
lforall a. Num a => a -> a -> a
+Int
1)
reverseTableau :: [[a]] -> [[a]]
reverseTableau :: forall a. [[a]] -> [[a]]
reverseTableau = 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
gtSimplexContent :: TriangularArray Int -> Int
gtSimplexContent :: TriangularArray Int -> Int
gtSimplexContent TriangularArray Int
arr = forall a. Ord a => a -> a -> a
max (TriangularArray Int
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a b. (a, b) -> a
fst (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds TriangularArray Int
arr))) (TriangularArray Int
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a b. (a, b) -> b
snd (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds TriangularArray Int
arr)))
_gtSimplexContent :: Tableau Int -> Int
_gtSimplexContent :: Tableau Int -> Int
_gtSimplexContent Tableau Int
t = forall a. Ord a => a -> a -> a
max (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head Tableau Int
t) (forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last Tableau Int
t)
normalize :: ReverseHoleTableau -> TriangularArray Int
normalize :: ReverseHoleTableau -> TriangularArray Int
normalize = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReverseHoleTableau -> (Int, TriangularArray Int)
normalize'
normalize' :: ReverseHoleTableau -> ( Int , TriangularArray Int )
normalize' :: ReverseHoleTableau -> (Int, TriangularArray Int)
normalize' ReverseHoleTableau
holes = ( Int
c , 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length ReverseHoleTableau
holes
c :: Int
c = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[((Int, Int), Hole)]]
sorted
xys :: [(Tri, Int)]
xys = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
groupSortBy forall a b. (a, b) -> b
snd (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((Int, Int), Hole)]]
withPos)
withPos :: [[((Int, Int), Hole)]]
withPos = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a} {b}. (Num a, Enum a) => a -> [b] -> [((a, a), b)]
f [Int
1..] (forall a. [[a]] -> [[a]]
reverseTableau ReverseHoleTableau
holes)
f :: a -> [b] -> [((a, a), b)]
f a
i [b]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall {a} {b} {b}. a -> b -> b -> ((a, b), b)
g a
i) [a
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) = 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 [] [] = forall a. HasCallStack => String -> a
error String
"startHole"
enumHoles :: Int -> Hole -> [Hole]
enumHoles :: Int -> Hole -> [Hole]
enumHoles Int
c start :: Hole
start@(Hole Int
k Int
l)
= Hole -> Hole
nextHole Hole
start
forall a. a -> [a] -> [a]
: [ Int -> Int -> Hole
Hole Int
i Int
0 | Int
i <- [Int
kforall a. Num a => a -> a -> a
+Int
1..Int
c] ] forall a. [a] -> [a] -> [a]
++ [ Int -> Int -> Hole
Hole Int
i Int
1 | Int
i <- [Int
kforall 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
tforall 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
tforall 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 = forall a. [a] -> a
head [Int]
lastReversed
last :: [Int]
last = forall a. [a] -> [a]
reverse (Int
top forall a. a -> [a] -> [a]
: [Int]
lastReversed)
newLines :: [Int] -> [[Hole]]
newLines :: [Int] -> ReverseHoleTableau
newLines [Int]
lastReversed = Int -> [Int] -> ReverseHoleTableau
newLines' (forall a. [a] -> a
head [Int]
lastReversed) [Int]
lastReversed
gtSimplexTableaux :: Int -> [TriangularArray Int]
gtSimplexTableaux :: Int -> [TriangularArray Int]
gtSimplexTableaux Int
0 = [ forall a. Tableau a -> TriangularArray a
triangularArrayUnsafe [] ]
gtSimplexTableaux Int
1 = [ forall a. Tableau a -> TriangularArray a
triangularArrayUnsafe [[Int
1]] ]
gtSimplexTableaux Int
k = forall a b. (a -> b) -> [a] -> [b]
map ReverseHoleTableau -> TriangularArray Int
normalize forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [[a]] -> [[a]]
reverseTableau forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TriangularArray a -> Tableau a
fromTriangularArray) forall a b. (a -> b) -> a -> b
$ Int -> [TriangularArray Int]
gtSimplexTableaux (Int
kforall a. Num a => a -> a -> a
-Int
1)
f :: [[Int]] -> [ [[Hole]] ]
f :: Tableau Int -> [ReverseHoleTableau]
f Tableau Int
small = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:ReverseHoleTableau
smallhole) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Int] -> ReverseHoleTableau
newLines (forall a. [a] -> a
head Tableau Int
small) where
smallhole :: ReverseHoleTableau
smallhole = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall a b. (a -> b) -> [a] -> [b]
map forall a. TriangularArray a -> Tableau a
fromTriangularArray forall a b. (a -> b) -> a -> b
$ Int -> [TriangularArray Int]
gtSimplexTableaux Int
k
countGTSimplexTableaux :: Int -> [Int]
countGTSimplexTableaux :: Int -> [Int]
countGTSimplexTableaux = forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems 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 i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
let (Int
a,Int
b) = ( Int
2forall a. Num a => a -> a -> a
*Int
kforall a. Num a => a -> a -> a
-Int
1 , Int -> Int
binom2 (Int
kforall a. Num a => a -> a -> a
+Int
1) )
STUArray s Int Int
ar <- 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)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. STUArray s Int Int -> TriangularArray Int -> ST s ()
worker STUArray s Int Int
ar) forall a b. (a -> b) -> a -> b
$ Int -> [TriangularArray Int]
gtSimplexTableaux Int
k
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 :: forall s. 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 <- 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
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
nforall a. Num a => a -> a -> a
+Int
1)
invertGTSimplexTableau :: TriangularArray Int -> TriangularArray Int
invertGTSimplexTableau :: TriangularArray Int -> TriangularArray Int
invertGTSimplexTableau TriangularArray Int
t = 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
cforall a. Num a => a -> a -> a
+Int
1forall a. Num a => a -> a -> a
-Int
x
_invertGTSimplexTableau :: [[Int]] -> [[Int]]
_invertGTSimplexTableau :: Tableau Int -> Tableau Int
_invertGTSimplexTableau Tableau Int
t = (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 -> Int
f Tableau Int
t where
c :: Int
c = Tableau Int -> Int
_gtSimplexContent Tableau Int
t
f :: Int -> Int
f Int
x = Int
cforall a. Num a => a -> a -> a
+Int
1forall a. Num a => a -> a -> a
-Int
x