{-|
Module      : Math.Algebra.Combinatorics
Description : 
Copyright   : (c) Stéphane Laurent, 2024
License     : GPL-3
Maintainer  : laurent_step@outlook.fr

This module provides some functions to compute Kostka numbers with a Jack
parameter, possibly skew, some functions to enumerate semistandard tableaux,
possibly skew, with a given shape and a given weight, and a function to 
enumerate the Gelfand-Tsetlin patterns defined by a skew partition.
-}

module Math.Algebra.Combinatorics
  (
  -- * Kostka numbers

    kostkaNumbers
  , symbolicKostkaNumbers
  , skewKostkaNumbers
  , symbolicSkewKostkaNumbers
  -- * Tableaux

  , semiStandardTableauxWithGivenShapeAndWeight
  , skewTableauxWithGivenShapeAndWeight
  -- * Gelfand-Tsetlin patterns

  , skewGelfandTsetlinPatterns
  ) where
import qualified Data.Foldable                    as DF
import           Data.Map.Strict                  ( 
                                                    Map
                                                  )
import qualified Data.Map.Strict                  as DM
import           Data.Tuple.Extra                 ( 
                                                    second  
                                                  )
import           Math.Algebra.Hspray              (
                                                    RatioOfQSprays
                                                  , unitRatioOfSprays
                                                  )
import           Math.Algebra.Jack.Internal       ( 
                                                    Partition
                                                  , _isPartition
                                                  , _kostkaNumbers
                                                  , _symbolicKostkaNumbers
                                                  , isSkewPartition
                                                  , skewJackInMSPbasis
                                                  , skewSymbolicJackInMSPbasis
                                                  , _skewGelfandTsetlinPatterns
                                                  , _skewTableauxWithGivenShapeAndWeight
                                                  , _semiStandardTableauxWithGivenShapeAndWeight
                                                  )
import           Math.Combinat.Tableaux.Skew      (
                                                    SkewTableau (..)
                                                  )

-- | Kostka numbers \(K_{\lambda,\mu}(\alpha)\) with Jack parameter, or 

-- Kostka-Jack numbers, for a given weight of the 

-- partitions \(\lambda\) and \(\mu\) and a given Jack parameter 

-- \(\alpha\) (these are the standard Kostka numbers when

-- \(\alpha=1\)). This returns a map whose keys represent the 

-- partitions \(\lambda\) and the value attached to a partition \(\lambda\)

-- represents the map \(\mu \mapsto K_{\lambda,\mu}(\alpha)\) where the 

-- partition \(\mu\) is included in the keys of this map if and only if 

-- \(K_{\lambda,\mu}(\alpha) \neq 0\). The Kostka-Jack number 

-- \(K_{\lambda,\mu}(\alpha)\) is the coefficient of the monomial symmetric 

-- polynomial \(m_\mu\) in the expression of the \(P\)-Jack polynomial 

-- \(P_\lambda(\alpha)\) as a linear combination of monomial symmetric 

-- polynomials.

kostkaNumbers :: 
     Int      -- ^ weight of the partitions

  -> Rational -- ^ Jack parameter

  -> Map Partition (Map Partition Rational)
kostkaNumbers :: Int -> Rational -> Map Partition (Map Partition Rational)
kostkaNumbers Int
weight Rational
alpha 
  | Int
weight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> Map Partition (Map Partition Rational)
forall a. HasCallStack => [Char] -> a
error [Char]
"kostkaNumbers: negative weight."
  | Int
weight Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      Partition
-> Map Partition Rational -> Map Partition (Map Partition Rational)
forall k a. k -> a -> Map k a
DM.singleton [] (Partition -> Rational -> Map Partition Rational
forall k a. k -> a -> Map k a
DM.singleton [] Rational
1)
  | Bool
otherwise =
      Int
-> Int
-> Rational
-> Char
-> Map Partition (Map Partition Rational)
forall a.
C a =>
Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_kostkaNumbers Int
weight Int
weight Rational
alpha Char
'P'

-- | Kostka numbers \(K_{\lambda,\mu}(\alpha)\) with symbolic Jack parameter \(\alpha\) 

-- for a given weight of the partitions \(\lambda\) and \(\mu\). This returns a map 

-- whose keys represent the 

-- partitions \(\lambda\) and the value attached to a partition \(\lambda\)

-- represents the map \(\mu \mapsto K_{\lambda,\mu}(\alpha)\) where the 

-- partition \(\mu\) is included in the keys of this map if and only if 

-- \(K_{\lambda,\mu}(\alpha) \neq 0\).

symbolicKostkaNumbers :: 
     Int  -- ^ weight of the partitions

  -> Map Partition (Map Partition RatioOfQSprays)
symbolicKostkaNumbers :: Int -> Map Partition (Map Partition RatioOfQSprays)
symbolicKostkaNumbers Int
weight
  | Int
weight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> Map Partition (Map Partition RatioOfQSprays)
forall a. HasCallStack => [Char] -> a
error [Char]
"symbolicKostkaNumbers: negative weight."
  | Int
weight Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      Partition
-> Map Partition RatioOfQSprays
-> Map Partition (Map Partition RatioOfQSprays)
forall k a. k -> a -> Map k a
DM.singleton [] (Partition -> RatioOfQSprays -> Map Partition RatioOfQSprays
forall k a. k -> a -> Map k a
DM.singleton [] RatioOfQSprays
forall a. (C a, Eq a) => RatioOfSprays a
unitRatioOfSprays)
  | Bool
otherwise =
      Int -> Int -> Char -> Map Partition (Map Partition RatioOfQSprays)
forall a.
(Eq a, C a) =>
Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_symbolicKostkaNumbers Int
weight Int
weight Char
'P'

-- | Skew Kostka numbers \(K_{\lambda/\mu, \nu}(\alpha)\) with a given Jack 

-- parameter \(\alpha\) and a given skew partition \(\lambda/\mu\). For \(\alpha=1\)

-- these are the ordinary skew Kostka numbers.

-- The function returns a map whose keys represent the partitions \(\nu\). 

-- The skew Kostka-Jack number \(K_{\lambda/\mu, \nu}(\alpha)\)

-- is the coefficient of the monomial symmetric 

-- polynomial \(m_\nu\) in the expression of the skew \(P\)-Jack polynomial 

-- \(P_{\lambda/\mu}(\alpha)\) as a linear combination of monomial symmetric 

-- polynomials.

skewKostkaNumbers ::
     Rational  -- ^ Jack parameter

  -> Partition -- ^ outer partition of the skew partition

  -> Partition -- ^ inner partition of the skew partition

  -> Map Partition Rational
skewKostkaNumbers :: Rational -> Partition -> Partition -> Map Partition Rational
skewKostkaNumbers Rational
alpha Partition
lambda Partition
mu 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
      [Char] -> Map Partition Rational
forall a. HasCallStack => [Char] -> a
error [Char]
"skewKostkaNumbers: invalid skew partition."
  | Bool
otherwise = 
      ((Int, Rational) -> Rational)
-> Map Partition (Int, Rational) -> Map Partition Rational
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (Int, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational
-> Char -> Partition -> Partition -> Map Partition (Int, Rational)
forall a.
(Eq a, C a) =>
a -> Char -> Partition -> Partition -> Map Partition (Int, a)
skewJackInMSPbasis Rational
alpha Char
'P' Partition
lambda Partition
mu)

-- | Skew Kostka numbers \(K_{\lambda/\mu, \nu}(\alpha)\) with symbolic Jack 

-- parameter \(\alpha\) for a given skew partition \(\lambda/\mu\). 

-- This returns a map whose keys represent the partitions \(\nu\).

symbolicSkewKostkaNumbers ::
     Partition -- ^ outer partition of the skew partition

  -> Partition -- ^ inner partition of the skew partition

  -> Map Partition RatioOfQSprays
symbolicSkewKostkaNumbers :: Partition -> Partition -> Map Partition RatioOfQSprays
symbolicSkewKostkaNumbers Partition
lambda Partition
mu 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
      [Char] -> Map Partition RatioOfQSprays
forall a. HasCallStack => [Char] -> a
error [Char]
"symbolicSkewKostkaNumbers: invalid skew partition."
  | Bool
otherwise = 
      ((Int, RatioOfQSprays) -> RatioOfQSprays)
-> Map Partition (Int, RatioOfQSprays)
-> Map Partition RatioOfQSprays
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (Int, RatioOfQSprays) -> RatioOfQSprays
forall a b. (a, b) -> b
snd (Char
-> Partition -> Partition -> Map Partition (Int, RatioOfQSprays)
forall a.
(Eq a, C a) =>
Char
-> Partition -> Partition -> Map Partition (Int, RatioOfSprays a)
skewSymbolicJackInMSPbasis Char
'P' Partition
lambda Partition
mu)

-- | Skew Gelfand-Tsetlin patterns defined by a skew partition and a weight vector.

skewGelfandTsetlinPatterns :: 
     Partition -- ^ outer partition of the skew partition

  -> Partition -- ^ inner partition of the skew partition

  -> [Int]     -- ^ weight

  -> [[Partition]]
skewGelfandTsetlinPatterns :: Partition -> Partition -> Partition -> [[Partition]]
skewGelfandTsetlinPatterns Partition
lambda Partition
mu Partition
weight 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
     [Char] -> [[Partition]]
forall a. HasCallStack => [Char] -> a
error [Char]
"skewGelfandTsetlinPatterns: invalid skew partition."
  | Bool
otherwise = 
      ([Seq Int] -> [Partition]) -> [[Seq Int]] -> [[Partition]]
forall a b. (a -> b) -> [a] -> [b]
map ((Seq Int -> Partition) -> [Seq Int] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList) (Partition -> Partition -> Partition -> [[Seq Int]]
_skewGelfandTsetlinPatterns Partition
lambda Partition
mu Partition
weight)

-- | Skew semistandard tableaux with a given shape (a skew partition) and

-- a given weight vector. The weight is the vector whose @i@-th element is the 

-- number of occurrences of @i@ in the tableau.

skewTableauxWithGivenShapeAndWeight :: 
     Partition -- ^ outer partition of the skew partition

  -> Partition -- ^ inner partition of the skew partition

  -> [Int]     -- ^ weight

  -> [SkewTableau Int] 
skewTableauxWithGivenShapeAndWeight :: Partition -> Partition -> Partition -> [SkewTableau Int]
skewTableauxWithGivenShapeAndWeight Partition
lambda Partition
mu Partition
weight 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
     [Char] -> [SkewTableau Int]
forall a. HasCallStack => [Char] -> a
error [Char]
"skewTableauxWithGivenShapeAndWeight: invalid skew partition."
  | Bool
otherwise = 
      ([(Int, Seq Int)] -> SkewTableau Int)
-> [[(Int, Seq Int)]] -> [SkewTableau Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Partition)] -> SkewTableau Int
forall a. [(Int, [a])] -> SkewTableau a
SkewTableau ([(Int, Partition)] -> SkewTableau Int)
-> ([(Int, Seq Int)] -> [(Int, Partition)])
-> [(Int, Seq Int)]
-> SkewTableau Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, Seq Int) -> (Int, Partition))
-> [(Int, Seq Int)] -> [(Int, Partition)]
forall a b. (a -> b) -> [a] -> [b]
map ((Seq Int -> Partition) -> (Int, Seq Int) -> (Int, Partition)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList)))
        (Partition -> Partition -> Partition -> [[(Int, Seq Int)]]
_skewTableauxWithGivenShapeAndWeight Partition
lambda Partition
mu Partition
weight)

-- | Semistandard tableaux with a given shape (an integer partition) and

-- a given weight vector. The weight is the vector whose @i@-th element is the 

-- number of occurrences of @i@ in the tableau.

semiStandardTableauxWithGivenShapeAndWeight :: 
     Partition   -- ^ shape, integer partition

  -> [Int]       -- ^ weight

  -> [[[Int]]]
semiStandardTableauxWithGivenShapeAndWeight :: Partition -> Partition -> [[Partition]]
semiStandardTableauxWithGivenShapeAndWeight Partition
lambda Partition
weight 
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) =
      [Char] -> [[Partition]]
forall a. HasCallStack => [Char] -> a
error [Char]
"semiStandardTableauxWithGivenShapeAndWeight: invalid partition."
  | (Int -> Bool) -> Partition -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) Partition
weight =
      []
  | Bool
otherwise = 
      ([Seq Int] -> [Partition]) -> [[Seq Int]] -> [[Partition]]
forall a b. (a -> b) -> [a] -> [b]
map ((Seq Int -> Partition) -> [Seq Int] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList) 
        (Partition -> Partition -> [[Seq Int]]
_semiStandardTableauxWithGivenShapeAndWeight Partition
lambda Partition
weight)