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

A Jack polynomial can have a very long expression in the canonical basis. 
A considerably shorter expression is obtained by writing the polynomial as 
a linear combination of the monomial symmetric polynomials instead, which is 
always possible since Jack polynomials are symmetric. This is the initial 
motivation of this module. But now it contains much more stuff dealing with 
symmetric polynomials.
-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Math.Algebra.SymmetricPolynomials
  ( 
  -- * Checking symmetry

    isSymmetricSpray
  -- * Classical symmetric polynomials

  , msPolynomial
  , psPolynomial
  , cshPolynomial
  , esPolynomial
  -- * Decomposition of symmetric polynomials

  , msCombination
  , psCombination
  , psCombination'
  , psCombination''
  , cshCombination
  , cshCombination'
  , esCombination
  , esCombination'
  , schurCombination
  , schurCombination'
  , jackCombination
  , jackCombination'
  , jackSymbolicCombination
  , jackSymbolicCombination'
  -- * Printing symmetric polynomials

  , prettySymmetricNumSpray
  , prettySymmetricQSpray
  , prettySymmetricQSpray'
  , prettySymmetricParametricQSpray
  , prettySymmetricSimpleParametricQSpray
  -- * Operators on the space of symmetric polynomials

  , laplaceBeltrami
  , calogeroSutherland
  -- * Hall inner product of symmetric polynomials

  , hallInnerProduct
  , hallInnerProduct'
  , hallInnerProduct''
  , hallInnerProduct'''
  , hallInnerProduct''''
  , symbolicHallInnerProduct
  , symbolicHallInnerProduct'
  , symbolicHallInnerProduct''
  -- * Kostka-Foulkes polynomials

  , kostkaFoulkesPolynomial
  , kostkaFoulkesPolynomial'
  , skewKostkaFoulkesPolynomial
  , skewKostkaFoulkesPolynomial'
  -- * qt-Kostka polynomials

  , qtKostkaPolynomials
  , qtKostkaPolynomials'
  , qtSkewKostkaPolynomials
  , qtSkewKostkaPolynomials'
  -- * Hall-Littlewood polynomials

  , hallLittlewoodPolynomial
  , hallLittlewoodPolynomial'
  , transitionsSchurToHallLittlewood
  , skewHallLittlewoodPolynomial
  , skewHallLittlewoodPolynomial'
  -- * Hall polynomials

  , hallPolynomials
  -- * t-Schur polynomials

  , tSchurPolynomial
  , tSchurPolynomial'
  , tSkewSchurPolynomial
  , tSkewSchurPolynomial'
  -- * Macdonald polynomials

  , macdonaldPolynomial
  , macdonaldPolynomial'
  , skewMacdonaldPolynomial
  , skewMacdonaldPolynomial'
  , macdonaldJpolynomial
  , macdonaldJpolynomial'
  , skewMacdonaldJpolynomial
  , skewMacdonaldJpolynomial'
  , modifiedMacdonaldPolynomial
  , modifiedMacdonaldPolynomial'
  -- * Flagged Schur polynomials

  , flaggedSchurPol
  , flaggedSchurPol'
  , flaggedSkewSchurPol
  , flaggedSkewSchurPol'
  -- * Factorial Schur polynomials

  , factorialSchurPol
  , factorialSchurPol'
  , skewFactorialSchurPol
  , skewFactorialSchurPol'
  ) where
import           Prelude hiding ( fromIntegral, fromRational )
import qualified Algebra.Additive                 as AlgAdd
import           Algebra.Field                    ( fromRational )
import qualified Algebra.Field                    as AlgField
import qualified Algebra.Module                   as AlgMod
import qualified Algebra.Ring                     as AlgRing
import           Algebra.ToInteger                ( fromIntegral )
import qualified Data.Foldable                    as DF
import qualified Data.HashMap.Strict              as HM
import           Data.IntMap.Strict               ( 
                                                    IntMap
                                                  )
import qualified Data.IntMap.Strict               as IM
import           Data.List                        ( 
                                                    foldl1'
                                                  , foldl'
                                                  , nub
                                                  )
import           Data.List.Extra                  ( 
                                                    unsnoc
                                                  , allSame
                                                  , drop1
                                                  )
import           Data.Map.Merge.Strict            ( 
                                                    merge
                                                  , dropMissing
                                                  , zipWithMatched 
                                                  )
import           Data.Map.Strict                  ( 
                                                    Map
                                                  , unionsWith
                                                  , insert
                                                  )
import qualified Data.Map.Strict                  as DM
import           Data.Maybe                       ( fromJust )
import           Data.Ratio                       ( (%) )
import           Data.Sequence                    ( 
                                                    Seq (..)
                                                  , (|>)
                                                  )
import qualified Data.Sequence                    as S
import           Math.Algebra.Hspray              (
                                                    FunctionLike (..)
                                                  , (/^)
                                                  , (.^)
                                                  , Spray
                                                  , Powers (..)
                                                  , QSpray
                                                  , QSpray'
                                                  , ParametricSpray
                                                  , ParametricQSpray
                                                  , SimpleParametricSpray
                                                  , SimpleParametricQSpray
                                                  , isZeroSpray
                                                  , lone
                                                  , qlone
                                                  , lone'
                                                  , qlone'
                                                  , fromList
                                                  , getCoefficient
                                                  , getConstantTerm
                                                  , isConstant
                                                  , (%//%)
                                                  , (%/%)
                                                  , RatioOfSprays (..)
                                                  , RatioOfQSprays
                                                  , asRatioOfSprays
                                                  , evalRatioOfSprays'
                                                  , constantRatioOfSprays
                                                  , zeroRatioOfSprays
                                                  , prettyRatioOfQSpraysXYZ
                                                  , showNumSpray
                                                  , showQSpray
                                                  , showQSpray'
                                                  , showSpray
                                                  , prettyQSprayXYZ
                                                  , zeroSpray
                                                  , unitSpray
                                                  , productOfSprays
                                                  , sumOfSprays
                                                  , constantSpray
                                                  , allExponents
                                                  , asSimpleParametricSprayUnsafe
                                                  )
import           Math.Algebra.Jack.Internal       ( 
                                                    Partition
                                                  , _isPartition
                                                  , msPolynomialUnsafe
                                                  , _esPolynomial
                                                  , sprayToMap
                                                  , comboToSpray 
                                                  , _inverseKostkaMatrix
                                                  , _inverseSymbolicKostkaMatrix
                                                  , _kostkaFoulkesPolynomial
                                                  , _skewKostkaFoulkesPolynomial
                                                  , _hallLittlewoodPolynomialsInSchurBasis
                                                  , _transitionMatrixHallLittlewoodSchur
                                                  , skewHallLittlewoodP
                                                  , skewHallLittlewoodQ
                                                  , isSkewPartition
                                                  , flaggedSemiStandardYoungTableaux
                                                  , tableauWeight
                                                  , isIncreasing
                                                  , flaggedSkewTableaux
                                                  , skewTableauWeight
                                                  , macdonaldPolynomialP
                                                  , macdonaldPolynomialQ
                                                  , skewMacdonaldPolynomialP
                                                  , skewMacdonaldPolynomialQ
                                                  , chi_lambda_mu_rho
                                                  , clambda
                                                  , clambdamu
                                                  , macdonaldJinMSPbasis
                                                  , inverseKostkaNumbers
                                                  , skewSchurLRCoefficients
                                                  , _msPolynomialInHLPbasis
                                                  )
import           Math.Algebra.JackPol             ( 
                                                    schurPol
                                                  )
import           Math.Combinat.Compositions       ( compositions1 )
import           Math.Combinat.Partitions.Integer ( 
                                                    fromPartition
                                                  , toPartition
                                                  , toPartitionUnsafe
                                                  , partitions 
                                                  , partitionWidth
                                                  )
import           Math.Combinat.Partitions.Skew    ( 
                                                    mkSkewPartition
                                                  )
import           Math.Combinat.Permutations       ( permuteMultiset )
import           Math.Combinat.Tableaux           ( semiStandardYoungTableaux )
import           Math.Combinat.Tableaux.GelfandTsetlin ( kostkaNumbersWithGivenMu )
import           Math.Combinat.Tableaux.Skew      ( 
                                                    SkewTableau (..) 
                                                  , semiStandardSkewTableaux 
                                                  )

-- | Monomial symmetric polynomial

--

-- >>> putStrLn $ prettySpray' (msPolynomial 3 [2, 1])

-- (1) x1^2.x2 + (1) x1^2.x3 + (1) x1.x2^2 + (1) x1.x3^2 + (1) x2^2.x3 + (1) x2.x3^2

msPolynomial :: (AlgRing.C a, Eq a) 
  => Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> Spray a
msPolynomial :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"msPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"msPolynomial: invalid partition."
  | Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n         = Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise                 = Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomialUnsafe Int
n Partition
lambda

-- | Checks whether a spray defines a symmetric polynomial.

--

-- >>> -- note that the sum of two symmetric polynomials is not symmetric

-- >>> -- if they have different numbers of variables:

-- >>> spray = schurPol' 4 [2, 2] ^+^ schurPol' 3 [2, 1]

-- >>> isSymmetricSpray spray

isSymmetricSpray :: (AlgRing.C a, Eq a) => Spray a -> Bool
isSymmetricSpray :: forall a. (C a, Eq a) => Spray a -> Bool
isSymmetricSpray Spray a
spray = Spray a
spray Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
spray' 
  where
    assocs :: [(Partition, a)]
assocs = Spray a -> [(Partition, a)]
forall a. C a => Spray a -> [(Partition, a)]
msCombination' Spray a
spray
    n :: Int
n      = Spray a -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables Spray a
spray
    spray' :: Spray a
spray' = (Spray a -> Spray a -> Spray a) -> [Spray a] -> Spray a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
(^+^) 
      (
        ((Partition, a) -> Spray a) -> [(Partition, a)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Partition
lambda, a
x) -> a
BaseRing (Spray a)
x BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomial Int
n Partition
lambda) [(Partition, a)]
assocs
      )

-- | Symmetric polynomial as a linear combination of monomial symmetric polynomials.

msCombination :: AlgRing.C a => Spray a -> Map Partition a
msCombination :: forall a. C a => Spray a -> Map Partition a
msCombination Spray a
spray = [(Partition, a)] -> Map Partition a
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList (Spray a -> [(Partition, a)]
forall a. C a => Spray a -> [(Partition, a)]
msCombination' Spray a
spray)

msCombination' :: AlgRing.C a => Spray a -> [(Partition, a)]
msCombination' :: forall a. C a => Spray a -> [(Partition, a)]
msCombination' Spray a
spray = 
  (Seq Int -> (Partition, a)) -> [Seq Int] -> [(Partition, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
lambda -> let mu :: Partition
mu = Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList Seq Int
lambda in (Partition
mu, Partition -> Spray a -> a
forall a. C a => Partition -> Spray a -> a
getCoefficient Partition
mu Spray a
spray)) 
        [Seq Int]
lambdas
  where
    decreasing :: Seq b -> Bool
decreasing Seq b
ys = Seq Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((b -> b -> Bool) -> Seq b -> Seq b -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Seq b
ys (Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
S.drop Int
1 Seq b
ys))
    lambdas :: [Seq Int]
lambdas = (Seq Int -> Bool) -> [Seq Int] -> [Seq Int]
forall a. (a -> Bool) -> [a] -> [a]
filter Seq Int -> Bool
forall {b}. Ord b => Seq b -> Bool
decreasing (Spray a -> [Seq Int]
forall a. Spray a -> [Seq Int]
allExponents Spray a
spray)

-- helper function for the showing stuff

makeMSpray :: (Eq a, AlgRing.C a) => Spray a -> Spray a
makeMSpray :: forall a. (Eq a, C a) => Spray a -> Spray a
makeMSpray = [(Partition, a)] -> Spray a
forall a. (C a, Eq a) => [(Partition, a)] -> Spray a
fromList ([(Partition, a)] -> Spray a)
-> (Spray a -> [(Partition, a)]) -> Spray a -> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spray a -> [(Partition, a)]
forall a. C a => Spray a -> [(Partition, a)]
msCombination'

-- show symmetric monomial like M[3,2,1]

showSymmetricMonomials :: [Seq Int] -> [String]
showSymmetricMonomials :: [Seq Int] -> [[Char]]
showSymmetricMonomials = (Seq Int -> [Char]) -> [Seq Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> [Char]
showSymmetricMonomial
  where
    showSymmetricMonomial :: Seq Int -> String
    showSymmetricMonomial :: Seq Int -> [Char]
showSymmetricMonomial Seq Int
lambda = Char
'M' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Partition -> [Char]
forall a. Show a => a -> [Char]
show (Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList Seq Int
lambda)

-- | Prints a symmetric spray as a linear combination of monomial symmetric polynomials

--

-- >>> putStrLn $ prettySymmetricNumSpray $ schurPol' 3 [3, 1, 1]

-- M[3,1,1] + M[2,2,1]

prettySymmetricNumSpray :: 
  (Num a, Ord a, Show a, AlgRing.C a) => Spray a -> String
prettySymmetricNumSpray :: forall a. (Num a, Ord a, Show a, C a) => Spray a -> [Char]
prettySymmetricNumSpray Spray a
spray = 
  ([Seq Int] -> [[Char]]) -> (a -> [Char]) -> Spray a -> [Char]
forall a.
(Num a, Ord a) =>
([Seq Int] -> [[Char]]) -> (a -> [Char]) -> Spray a -> [Char]
showNumSpray [Seq Int] -> [[Char]]
showSymmetricMonomials a -> [Char]
forall a. Show a => a -> [Char]
show Spray a
mspray
  where
    mspray :: Spray a
mspray = Spray a -> Spray a
forall a. (Eq a, C a) => Spray a -> Spray a
makeMSpray Spray a
spray

-- | Prints a symmetric spray as a linear combination of monomial symmetric polynomials

--

-- >>> putStrLn $ prettySymmetricQSpray $ jackPol' 3 [3, 1, 1] 2 'J'

-- 42*M[3,1,1] + 28*M[2,2,1]

prettySymmetricQSpray :: QSpray -> String
prettySymmetricQSpray :: QSpray -> [Char]
prettySymmetricQSpray QSpray
spray = ([Seq Int] -> [[Char]]) -> QSpray -> [Char]
showQSpray [Seq Int] -> [[Char]]
showSymmetricMonomials QSpray
mspray
  where
    mspray :: QSpray
mspray = QSpray -> QSpray
forall a. (Eq a, C a) => Spray a -> Spray a
makeMSpray QSpray
spray

-- | Same as `prettySymmetricQSpray` but for a `QSpray'` symmetric spray

prettySymmetricQSpray' :: QSpray' -> String
prettySymmetricQSpray' :: QSpray' -> [Char]
prettySymmetricQSpray' QSpray'
spray = ([Seq Int] -> [[Char]]) -> QSpray' -> [Char]
showQSpray' [Seq Int] -> [[Char]]
showSymmetricMonomials QSpray'
mspray
  where
    mspray :: QSpray'
mspray = QSpray' -> QSpray'
forall a. (Eq a, C a) => Spray a -> Spray a
makeMSpray QSpray'
spray

-- | Prints a symmetric parametric spray as a linear combination of monomial 

-- symmetric polynomials.

--

-- >>> putStrLn $ prettySymmetricParametricQSpray ["a"] $ jackSymbolicPol' 3 [3, 1, 1] 'J'

-- { [ 4*a^2 + 10*a + 6 ] }*M[3,1,1] + { [ 8*a + 12 ] }*M[2,2,1]

prettySymmetricParametricQSpray :: [String] -> ParametricQSpray -> String
prettySymmetricParametricQSpray :: [[Char]] -> ParametricQSpray -> [Char]
prettySymmetricParametricQSpray [[Char]]
letters ParametricQSpray
spray = 
  (RatioOfQSprays -> [Char])
-> ([Char], [Char])
-> ([Seq Int] -> [[Char]])
-> ParametricQSpray
-> [Char]
forall a.
(a -> [Char])
-> ([Char], [Char]) -> ([Seq Int] -> [[Char]]) -> Spray a -> [Char]
showSpray ([[Char]] -> RatioOfQSprays -> [Char]
prettyRatioOfQSpraysXYZ [[Char]]
letters) ([Char]
"{ ", [Char]
" }") 
            [Seq Int] -> [[Char]]
showSymmetricMonomials ParametricQSpray
mspray
  where
    mspray :: ParametricQSpray
mspray = ParametricQSpray -> ParametricQSpray
forall a. (Eq a, C a) => Spray a -> Spray a
makeMSpray ParametricQSpray
spray

-- | Prints a symmetric simple parametric spray as a linear combination of monomial 

-- symmetric polynomials.

prettySymmetricSimpleParametricQSpray :: 
  [String] -> SimpleParametricQSpray -> String
prettySymmetricSimpleParametricQSpray :: [[Char]] -> SimpleParametricQSpray -> [Char]
prettySymmetricSimpleParametricQSpray [[Char]]
letters SimpleParametricQSpray
spray = 
  (QSpray -> [Char])
-> ([Char], [Char])
-> ([Seq Int] -> [[Char]])
-> SimpleParametricQSpray
-> [Char]
forall a.
(a -> [Char])
-> ([Char], [Char]) -> ([Seq Int] -> [[Char]]) -> Spray a -> [Char]
showSpray ([[Char]] -> QSpray -> [Char]
prettyQSprayXYZ [[Char]]
letters) ([Char]
"(", [Char]
")") 
            [Seq Int] -> [[Char]]
showSymmetricMonomials SimpleParametricQSpray
mspray
  where
    mspray :: SimpleParametricQSpray
mspray = SimpleParametricQSpray -> SimpleParametricQSpray
forall a. (Eq a, C a) => Spray a -> Spray a
makeMSpray SimpleParametricQSpray
spray

-- | Laplace-Beltrami operator on the space of homogeneous symmetric polynomials;

-- neither symmetry and homogeneity are checked.

laplaceBeltrami :: (Eq a, AlgField.C a) => a -> Spray a -> Spray a
laplaceBeltrami :: forall a. (Eq a, C a) => a -> Spray a -> Spray a
laplaceBeltrami a
alpha Spray a
spray = 
  if Spray a -> Bool
forall b. FunctionLike b => b -> Bool
isConstant Spray a
spray 
    then Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray 
    else a
BaseRing (Spray a)
alpha' BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
spray1 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ Spray a
spray2
  where
    alpha' :: a
alpha' = a
alpha a -> a -> a
forall a. C a => a -> a -> a
AlgField./ Integer -> a
forall a. C a => Integer -> a
AlgRing.fromInteger Integer
2
    n :: Int
n = Spray a -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables Spray a
spray
    range :: Partition
range = [Int
1 .. Int
n]
    dsprays :: [Spray a]
dsprays = (Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Spray a -> Spray a
forall b. FunctionLike b => Int -> b -> b
`derivative` Spray a
spray) Partition
range
    op1 :: Int -> Spray a
op1 Int
i = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
i Int
2 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Int -> Spray a -> Spray a
forall b. FunctionLike b => Int -> b -> b
derivative Int
i ([Spray a]
dsprays [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
    spray1 :: Spray a
spray1 = [Spray a] -> Spray a
forall a. C a => [a] -> a
AlgAdd.sum ((Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Spray a
op1 Partition
range)
    spray2 :: Spray a
spray2 = RatioOfSprays a -> Spray a
forall a. RatioOfSprays a -> Spray a
_numerator (RatioOfSprays a -> Spray a) -> RatioOfSprays a -> Spray a
forall a b. (a -> b) -> a -> b
$ [RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum 
              [(Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
i Int
2 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ [Spray a]
dsprays [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% (Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
i Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
j)
                | Int
i <- Partition
range, Int
j <- Partition
range, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
j]

-- | Calogero-Sutherland operator on the space of homogeneous symmetric polynomials;

-- neither symmetry and homogeneity are checked

calogeroSutherland :: (Eq a, AlgField.C a) => a -> Spray a -> Spray a
calogeroSutherland :: forall a. (Eq a, C a) => a -> Spray a -> Spray a
calogeroSutherland a
alpha Spray a
spray = 
  if Spray a -> Bool
forall b. FunctionLike b => b -> Bool
isConstant Spray a
spray 
    then Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
    else Spray a -> Spray a
forall {a}. (C a, Eq a) => Spray a -> Spray a
halfSpray (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ a
BaseRing (Spray a)
alpha BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
spray1 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ Spray a
spray2
  where
    halfSpray :: Spray a -> Spray a
halfSpray Spray a
p = Spray a
p Spray a -> a -> Spray a
forall a. (C a, Eq a) => Spray a -> a -> Spray a
/^ Integer -> a
forall a. C a => Integer -> a
AlgRing.fromInteger Integer
2
    n :: Int
n = Spray a -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables Spray a
spray
    range :: Partition
range = [Int
1 .. Int
n]
    dsprays :: [Spray a]
dsprays = (Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Spray a -> Spray a
forall b. FunctionLike b => Int -> b -> b
`derivative` Spray a
spray) Partition
range
    op0 :: Spray a -> Int -> Spray a
op0 Spray a
p Int
i = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
i Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Int -> Spray a -> Spray a
forall b. FunctionLike b => Int -> b -> b
derivative Int
i Spray a
p 
    op1 :: Spray a -> Int -> Spray a
op1 Spray a
p Int
i = Spray a -> Int -> Spray a
forall {a}. (Eq a, C a) => Spray a -> Int -> Spray a
op0 (Spray a -> Int -> Spray a
forall {a}. (Eq a, C a) => Spray a -> Int -> Spray a
op0 Spray a
p Int
i) Int
i
    spray1 :: Spray a
spray1 = [Spray a] -> Spray a
forall a. C a => [a] -> a
AlgAdd.sum ((Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Spray a -> Int -> Spray a
forall {a}. (Eq a, C a) => Spray a -> Int -> Spray a
op1 Spray a
spray) Partition
range)
    spray2 :: Spray a
spray2 = RatioOfSprays a -> Spray a
forall a. RatioOfSprays a -> Spray a
_numerator (RatioOfSprays a -> Spray a) -> RatioOfSprays a -> Spray a
forall a b. (a -> b) -> a -> b
$ [RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum 
      [let (Spray a
xi, Spray a
xj, Spray a
dxi, Spray a
dxj) = 
            (Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
i, Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
j, [Spray a]
dsprays [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), [Spray a]
dsprays [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) in 
          (Spray a
xi Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ Spray a
xj) Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ (Spray a
xi Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
dxi Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Spray a
xj Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
dxj) Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% (Spray a
xi Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Spray a
xj)
       | Int
i <- Partition
range, Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
n]]

-- | Power sum polynomial

--

-- >>> putStrLn $ prettyQSpray (psPolynomial 3 [2, 1])

-- x^3 + x^2.y + x^2.z + x.y^2 + x.z^2 + y^3 + y^2.z + y.z^2 + z^3

psPolynomial :: (AlgRing.C a, Eq a) 
  => Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> Spray a
psPolynomial :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
psPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"psPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"psPolynomial: invalid partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda               = Spray a
forall a. C a => Spray a
unitSpray
--  | any (> n) lambda          = zeroSpray

--  | llambda > n               = zeroSpray

  | Bool
otherwise                 = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Spray a]
sprays
    where
--      llambda = length lambda

      -- lists = [[(Powers (S.replicate (j-1) 0 |> k) j, AlgRing.one) | j <- [1 .. n]] | k <- lambda]

      -- expts = map (\j -> (j, S.replicate j 0)) [0 .. n-1]

      -- f k = map (\(j, sq) -> (Powers (sq |> k) j, AlgRing.one)) expts

      sprays :: [Spray a]
sprays = [[(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Powers, a)] -> Spray a) -> [(Powers, a)] -> Spray a
forall a b. (a -> b) -> a -> b
$ [Int -> Int -> (Powers, a)
forall {b}. C b => Int -> Int -> (Powers, b)
f Int
i Int
k | Int
i <- [Int
1 .. Int
n]] | Int
k <- Partition
lambda]
      f :: Int -> Int -> (Powers, b)
f Int
j Int
k = (Seq Int -> Int -> Powers
Powers Seq Int
expts Int
j, b
forall a. C a => a
AlgRing.one)
        where
          expts :: Seq Int
expts = Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0 Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
k

eLambdaMu :: Partition -> Partition -> Rational
eLambdaMu :: Partition -> Partition -> Rational
eLambdaMu Partition
lambda Partition
mu 
  | Int
ellLambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ellMu = Rational
0
  | Bool
otherwise = if Int -> Bool
forall a. Integral a => a -> Bool
even (Int
ellLambda Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ellMu) 
      then [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
xs 
      else - [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
xs
  where
    ellLambda :: Int
ellLambda = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
    ellMu :: Int
ellMu     = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
mu
    compos :: [Partition]
compos = Int -> Int -> [Partition]
forall a. Integral a => a -> a -> [Partition]
compositions1 Int
ellMu Int
ellLambda
    lambdaPerms :: [Partition]
lambdaPerms = Partition -> [Partition]
forall a. (Eq a, Ord a) => [a] -> [[a]]
permuteMultiset Partition
lambda
    sequencesOfPartitions :: [[Partition]]
sequencesOfPartitions = ([Partition] -> Bool) -> [[Partition]] -> [[Partition]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Partition] -> Bool) -> [Partition] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Partition] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
      [Partition -> Partition -> [Partition]
partitionSequences Partition
perm Partition
compo 
        | Partition
perm <- [Partition]
lambdaPerms, Partition
compo <- [Partition]
compos]
    xs :: [Rational]
xs = [[Partition] -> Rational
eMuNus [Partition]
nus | [Partition]
nus <- [[Partition]]
sequencesOfPartitions]
    ----

    partitionSequences :: [Int] -> [Int] -> [Partition]
    partitionSequences :: Partition -> Partition -> [Partition]
partitionSequences Partition
kappa Partition
compo = if Bool
test then [Partition]
nus else []
      where
        headOfCompo :: Partition
headOfCompo = (Partition, Int) -> Partition
forall a b. (a, b) -> a
fst ((Partition, Int) -> Partition) -> (Partition, Int) -> Partition
forall a b. (a -> b) -> a -> b
$ Maybe (Partition, Int) -> (Partition, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (Partition -> Maybe (Partition, Int)
forall a. [a] -> Maybe ([a], a)
unsnoc Partition
compo)
        starts :: Partition
starts = (Int -> Int -> Int) -> Int -> Partition -> Partition
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 Partition
headOfCompo 
        ends :: Partition
ends   = (Int -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Partition
starts Partition
compo
        nus :: [Partition]
nus = [ 
                [ Partition
kappa Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
k | Int
k <- [Partition
starts Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i .. Partition
ends Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ] 
                | Int
i <- [Int
0 .. Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
compo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
              ]
        nuWeights :: Partition
nuWeights = [Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
nu | Partition
nu <- [Partition]
nus]
        decreasing :: [b] -> Bool
decreasing [b]
ys = 
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((b -> b -> Bool) -> [b] -> [b] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [b]
ys ([b] -> [b]
forall a. [a] -> [a]
drop1 [b]
ys))
--          and [ys !! i >= ys !! (i+1) | i <- [0 .. length ys - 2]]

        test :: Bool
test = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> Partition -> Partition -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Partition
mu Partition
nuWeights) Bool -> Bool -> Bool
&& (Partition -> Bool) -> [Partition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Partition -> Bool
forall {b}. Ord b => [b] -> Bool
decreasing [Partition]
nus
    ---- 

    eMuNus :: [Partition] -> Rational
    eMuNus :: [Partition] -> Rational
eMuNus [Partition]
nus = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Rational]
toMultiply
      where
        w :: Int -> Partition -> Rational
        w :: Int -> Partition -> Rational
w Int
k Partition
nu = 
          let table :: Partition
table = [Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) | Int
i <- Partition
nu] | Int
j <- Partition -> Partition
forall a. Eq a => [a] -> [a]
nub Partition
nu] in
          (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall {a}. (Num a, Enum a) => a -> a
factorial (Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% 
            (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall {a}. (Num a, Enum a) => a -> a
factorial Partition
table))
        factorial :: a -> a
factorial a
n = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a
2 .. a
n]
        toMultiply :: [Rational]
toMultiply = (Int -> Partition -> Rational)
-> Partition -> [Partition] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Partition -> Rational
w Partition
mu [Partition]
nus

-- | monomial symmetric polynomial as a linear combination of 

-- power sum polynomials

mspInPSbasis :: Partition -> Map Partition Rational
mspInPSbasis :: Partition -> Map Partition Rational
mspInPSbasis Partition
kappa = 
  (Rational -> Bool)
-> Map Partition Rational -> Map Partition Rational
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0) ([(Partition, Rational)] -> Map Partition Rational
forall k a. [(k, a)] -> Map k a
DM.fromDistinctAscList [(Partition, Rational)]
lambdas_and_weights) 
  where
    parts :: [Partition]
parts = Int -> [Partition]
partitions (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
kappa)
    lambdas_and_weights :: [(Partition, Rational)]
lambdas_and_weights = 
      [let lambda :: Partition
lambda = Partition -> Partition
fromPartition Partition
part 
           weight :: Rational
weight = Partition -> Partition -> Rational
eLambdaMu Partition
kappa Partition
lambda in
         (Partition
lambda, Rational
weight Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a. Real a => a -> Rational
toRational (Partition -> Int
zlambda Partition
lambda))
        | Partition
part <- [Partition]
parts]

-- | the factor in the Hall inner product

zlambda :: Partition -> Int
zlambda :: Partition -> Int
zlambda Partition
lambda = Int
p
  where
    parts :: Partition
parts = Partition -> Partition
forall a. Eq a => [a] -> [a]
nub Partition
lambda
    table :: [(Int, Int)]
table = [(Int
j, Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) | Int
k <- Partition
lambda]) | Int
j <- Partition
parts]
    p :: Int
p =  
      Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int -> Int
forall {a}. (Num a, Enum a) => a -> a
factorial Int
mj Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
partInt -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
mj | (Int
part, Int
mj) <- [(Int, Int)]
table]
    factorial :: a -> a
factorial a
n = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a
2 .. a
n]

_symmPolyCombination :: 
    forall a b. (Eq a, AlgRing.C a) 
  => (Partition -> Map Partition b) 
  -> (a -> b -> a) 
  -> Spray a 
  -> Map Partition a
_symmPolyCombination :: forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination Partition -> Map Partition b
mspInSymmPolyBasis a -> b -> a
func Spray a
spray =
  if a
constantTerm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero 
    then Map Partition a
symmPolyMap
    else Partition -> a -> Map Partition a -> Map Partition a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [] a
constantTerm Map Partition a
symmPolyMap
  where
    constantTerm :: a
constantTerm = Spray a -> a
forall a. C a => Spray a -> a
getConstantTerm Spray a
spray
    msCombo :: Map Partition a
msCombo = 
      Spray a -> Map Partition a
forall a. C a => Spray a -> Map Partition a
msCombination (Spray a
spray Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ (a -> a
forall a. C a => a -> a
AlgAdd.negate a
constantTerm)) :: Map Partition a
    f :: Partition -> a -> Map Partition a
    f :: Partition -> a -> Map Partition a
f Partition
lambda a
coeff = 
      (b -> a) -> Map Partition b -> Map Partition a
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (a -> b -> a
func a
coeff) Map Partition b
symmPolyCombo
      where
        symmPolyCombo :: Map Partition b
symmPolyCombo = Partition -> Map Partition b
mspInSymmPolyBasis Partition
lambda :: Map Partition b
    symmPolyMap :: Map Partition a
symmPolyMap = 
      (a -> Bool) -> Map Partition a -> Map Partition a
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. C a => a
AlgAdd.zero) 
        ((Map Partition a -> Partition -> a -> Map Partition a)
-> Map Partition a -> Map Partition a -> Map Partition a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
DM.foldlWithKey' 
          (\Map Partition a
m Partition
lambda a
coeff -> (a -> a -> a)
-> Map Partition a -> Map Partition a -> Map Partition a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
DM.unionWith a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) Map Partition a
m (Partition -> a -> Map Partition a
f Partition
lambda a
coeff)) 
            Map Partition a
forall k a. Map k a
DM.empty Map Partition a
msCombo)

-- | symmetric polynomial as a linear combination of power sum polynomials

_psCombination :: 
  (Eq a, AlgRing.C a) => (a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination :: forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination = (Partition -> Map Partition Rational)
-> (a -> Rational -> a) -> Spray a -> Map Partition a
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination Partition -> Map Partition Rational
mspInPSbasis

-- | Symmetric polynomial as a linear combination of power sum polynomials. 

-- Symmetry is not checked.

psCombination :: 
  (Eq a, AlgField.C a) => Spray a -> Map Partition a
psCombination :: forall a. (Eq a, C a) => Spray a -> Map Partition a
psCombination = (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination (\a
coef Rational
r -> a
coef a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* Rational -> a
forall a. C a => Rational -> a
fromRational Rational
r)

-- | Symmetric polynomial as a linear combination of power sum polynomials. 

-- Same as @psCombination@ but with other constraints on the base ring of the spray.

psCombination' :: 
  (Eq a, AlgMod.C Rational a, AlgRing.C a) 
  => Spray a -> Map Partition a
psCombination' :: forall a. (Eq a, C Rational a, C a) => Spray a -> Map Partition a
psCombination' = (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination ((Rational -> a -> a) -> a -> Rational -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> a -> a
forall a v. C a v => a -> v -> v
(AlgMod.*>))

-- | Symmetric parametric spray as a linear combination of power sum polynomials. 

psCombination'' ::
    (FunctionLike b, Eq b, AlgRing.C b, AlgField.C (BaseRing b))
  => Spray b    -- ^ parametric spray

  -> Map Partition b  
psCombination'' :: forall b.
(FunctionLike b, Eq b, C b, C (BaseRing b)) =>
Spray b -> Map Partition b
psCombination'' = 
  (b -> Rational -> b) -> Spray b -> Map Partition b
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination (\b
coef Rational
r -> Rational -> BaseRing b
forall a. C a => Rational -> a
fromRational Rational
r BaseRing b -> b -> b
forall b. FunctionLike b => BaseRing b -> b -> b
*^ b
coef)

-- | the Hall inner product with parameter

_hallInnerProduct :: 
  forall a b. (AlgRing.C b, AlgRing.C a)
  => (Spray b -> Map Partition b)
  -> (a -> b -> b)
  -> Spray b   -- ^ spray

  -> Spray b   -- ^ spray

  -> a         -- ^ parameter

  -> b 
_hallInnerProduct :: forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct Spray b -> Map Partition b
psCombinationFunc a -> b -> b
multabFunc Spray b
spray1 Spray b
spray2 a
alpha = 
  [b] -> b
forall a. C a => [a] -> a
AlgAdd.sum ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ Map Partition b -> [b]
forall k a. Map k a -> [a]
DM.elems
    (SimpleWhenMissing Partition b b
-> SimpleWhenMissing Partition b b
-> SimpleWhenMatched Partition b b b
-> Map Partition b
-> Map Partition b
-> Map Partition b
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing Partition b b
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing SimpleWhenMissing Partition b b
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing ((Partition -> b -> b -> b) -> SimpleWhenMatched Partition b b b
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched Partition -> b -> b -> b
f) Map Partition b
psCombo1 Map Partition b
psCombo2)
  where
    psCombo1 :: Map Partition b
psCombo1 = Spray b -> Map Partition b
psCombinationFunc Spray b
spray1 :: Map Partition b
    psCombo2 :: Map Partition b
psCombo2 = Spray b -> Map Partition b
psCombinationFunc Spray b
spray2 :: Map Partition b
    zlambda' :: Partition -> a
    zlambda' :: Partition -> a
zlambda' Partition
lambda = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Partition -> Int
zlambda Partition
lambda) 
      a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
alpha a -> Integer -> a
forall a. C a => a -> Integer -> a
AlgRing.^ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda)
    f :: Partition -> b -> b -> b
    f :: Partition -> b -> b -> b
f Partition
lambda b
coeff1 b
coeff2 = 
      a -> b -> b
multabFunc (Partition -> a
zlambda' Partition
lambda) (b
coeff1 b -> b -> b
forall a. C a => a -> a -> a
AlgRing.* b
coeff2)

-- | Hall inner product with Jack parameter, aka Jack scalar product. It 

-- makes sense only for symmetric sprays, and the symmetry is not checked. 

hallInnerProduct :: 
  (Eq a, AlgField.C a)
  => Spray a   -- ^ spray

  -> Spray a   -- ^ spray

  -> a         -- ^ parameter

  -> a 
hallInnerProduct :: forall a. (Eq a, C a) => Spray a -> Spray a -> a -> a
hallInnerProduct = (Spray a -> Map Partition a)
-> (a -> a -> a) -> Spray a -> Spray a -> a -> a
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct Spray a -> Map Partition a
forall a. (Eq a, C a) => Spray a -> Map Partition a
psCombination a -> a -> a
forall a. C a => a -> a -> a
(AlgRing.*)

-- | Hall inner product with Jack parameter. Same as @hallInnerProduct@ but 

-- with other constraints on the base ring of the sprays.

hallInnerProduct' :: 
  (Eq a, AlgMod.C Rational a, AlgRing.C a)
  => Spray a   -- ^ spray

  -> Spray a   -- ^ spray

  -> a         -- ^ parameter

  -> a 
hallInnerProduct' :: forall a. (Eq a, C Rational a, C a) => Spray a -> Spray a -> a -> a
hallInnerProduct' = (Spray a -> Map Partition a)
-> (a -> a -> a) -> Spray a -> Spray a -> a -> a
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct Spray a -> Map Partition a
forall a. (Eq a, C Rational a, C a) => Spray a -> Map Partition a
psCombination' a -> a -> a
forall a. C a => a -> a -> a
(AlgRing.*)

-- | Hall inner product with Jack parameter. Same as @hallInnerProduct@ but 

-- with other constraints on the base ring of the sprays. It is applicable 

-- to @Spray Int@ sprays.

hallInnerProduct'' :: 
  forall a. (Real a)
  => Spray a   -- ^ spray

  -> Spray a   -- ^ spray

  -> a         -- ^ parameter

  -> Rational 
hallInnerProduct'' :: forall a. Real a => Spray a -> Spray a -> a -> Rational
hallInnerProduct'' Spray a
spray1 Spray a
spray2 a
alpha = 
  (QSpray -> Map Partition Rational)
-> (Rational -> Rational -> Rational)
-> QSpray
-> QSpray
-> Rational
-> Rational
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct 
    ((Rational -> Rational -> Rational)
-> QSpray -> Map Partition Rational
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*) QSpray
qspray1 QSpray
qspray2 (a -> Rational
forall a. Real a => a -> Rational
toRational a
alpha)
  where
    asQSpray :: Spray a -> QSpray
    asQSpray :: Spray a -> QSpray
asQSpray = (a -> Rational) -> Spray a -> QSpray
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Rational
forall a. Real a => a -> Rational
toRational
    qspray1 :: QSpray
qspray1 = Spray a -> QSpray
asQSpray Spray a
spray1
    qspray2 :: QSpray
qspray2 = Spray a -> QSpray
asQSpray Spray a
spray2

-- | Hall inner product with Jack parameter for parametric sprays, because the

-- type of the parameter in @hallInnerProduct@ is strange. For example, a

-- @ParametricQSpray@ spray is a @Spray RatioOfQSprays@ spray, and it makes

-- more sense to compute the Hall product with a @Rational@ parameter then 

-- to compute the Hall product with a @RatioOfQSprays@ parameter.

--

-- >>> import Math.Algebra.Jack.SymmetricPolynomials

-- >>> import Math.Algebra.JackSymbolicPol

-- >>> import Math.Algebra.Hspray

-- >>> jp = jackSymbolicPol 3 [2, 1] 'P'

-- >>> hallInnerProduct''' jp jp 5 == hallInnerProduct jp jp (constantRatioOfSprays 5)

hallInnerProduct''' :: 
  (Eq b, AlgField.C b, AlgMod.C (BaseRing b) b)
  => Spray b    -- ^ parametric spray

  -> Spray b    -- ^ parametric spray

  -> BaseRing b -- ^ parameter

  -> b 
hallInnerProduct''' :: forall b.
(Eq b, C b, C (BaseRing b) b) =>
Spray b -> Spray b -> BaseRing b -> b
hallInnerProduct''' = (HashMap Powers b -> Map Partition b)
-> (BaseRing b -> b -> b)
-> HashMap Powers b
-> HashMap Powers b
-> BaseRing b
-> b
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct HashMap Powers b -> Map Partition b
forall a. (Eq a, C a) => Spray a -> Map Partition a
psCombination BaseRing b -> b -> b
forall a v. C a v => a -> v -> v
(AlgMod.*>) 

-- | Hall inner product with Jack parameter for parametric sprays. Same as 

-- @hallInnerProduct'''@ but with other constraints on the types. It is 

-- applicable to @SimpleParametricQSpray@ sprays, while @hallInnerProduct'''@ 

-- is not.

hallInnerProduct'''' :: 
  (Eq b, AlgRing.C b, AlgMod.C Rational b, AlgMod.C (BaseRing b) b)
  => Spray b    -- ^ parametric spray

  -> Spray b    -- ^ parametric spray

  -> BaseRing b -- ^ parameter

  -> b 
hallInnerProduct'''' :: forall b.
(Eq b, C b, C Rational b, C (BaseRing b) b) =>
Spray b -> Spray b -> BaseRing b -> b
hallInnerProduct'''' = (HashMap Powers b -> Map Partition b)
-> (BaseRing b -> b -> b)
-> HashMap Powers b
-> HashMap Powers b
-> BaseRing b
-> b
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct HashMap Powers b -> Map Partition b
forall a. (Eq a, C Rational a, C a) => Spray a -> Map Partition a
psCombination' BaseRing b -> b -> b
forall a v. C a v => a -> v -> v
(AlgMod.*>) 

-- | the Hall inner product with symbolic parameter

_symbolicHallInnerProduct :: 
  (Eq a, AlgRing.C a) 
  => (Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a) 
  -> Spray a -> Spray a -> Spray a
_symbolicHallInnerProduct :: forall a.
(Eq a, C a) =>
(Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a)
-> Spray a -> Spray a -> Spray a
_symbolicHallInnerProduct Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a
func Spray a
spray1 Spray a
spray2 = Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a
func Spray (Spray a)
spray1' Spray (Spray a)
spray2' (Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
1)
  where
    spray1' :: Spray (Spray a)
spray1' = (a -> Spray a) -> Spray a -> Spray (Spray a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Spray a
forall a. (Eq a, C a) => a -> Spray a
constantSpray Spray a
spray1
    spray2' :: Spray (Spray a)
spray2' = (a -> Spray a) -> Spray a -> Spray (Spray a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Spray a
forall a. (Eq a, C a) => a -> Spray a
constantSpray Spray a
spray2

-- | Hall inner product with symbolic Jack parameter. See README for some examples.

symbolicHallInnerProduct :: 
  (Eq a, AlgField.C a) => Spray a -> Spray a -> Spray a
symbolicHallInnerProduct :: forall a. (Eq a, C a) => Spray a -> Spray a -> Spray a
symbolicHallInnerProduct =
  (Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a)
-> Spray a -> Spray a -> Spray a
forall a.
(Eq a, C a) =>
(Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a)
-> Spray a -> Spray a -> Spray a
_symbolicHallInnerProduct 
    (
      (Spray (Spray a) -> Map Partition (Spray a))
-> (Spray a -> Spray a -> Spray a)
-> Spray (Spray a)
-> Spray (Spray a)
-> Spray a
-> Spray a
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct 
        ((Spray a -> Rational -> Spray a)
-> Spray (Spray a) -> Map Partition (Spray a)
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination (\Spray a
spray_a Rational
r -> Rational -> a
forall a. C a => Rational -> a
fromRational Rational
r BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
spray_a)) Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
(^*^)
    ) 

-- | Hall inner product with symbolic Jack parameter. Same as @symbolicHallInnerProduct@ 

-- but with other type constraints.

symbolicHallInnerProduct' :: 
  (Eq a, AlgMod.C Rational (Spray a), AlgRing.C a) 
  => Spray a -> Spray a -> Spray a
symbolicHallInnerProduct' :: forall a.
(Eq a, C Rational (Spray a), C a) =>
Spray a -> Spray a -> Spray a
symbolicHallInnerProduct' =  (Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a)
-> Spray a -> Spray a -> Spray a
forall a.
(Eq a, C a) =>
(Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a)
-> Spray a -> Spray a -> Spray a
_symbolicHallInnerProduct (Spray (Spray a) -> Spray (Spray a) -> Spray a -> Spray a
forall a. (Eq a, C Rational a, C a) => Spray a -> Spray a -> a -> a
hallInnerProduct')

-- | Hall inner product with symbolic Jack parameter. Same as @symbolicHallInnerProduct@ 

-- but with other type constraints. It is applicable to @Spray Int@ sprays.

symbolicHallInnerProduct'' :: forall a. Real a => Spray a -> Spray a -> QSpray
symbolicHallInnerProduct'' :: forall a. Real a => Spray a -> Spray a -> QSpray
symbolicHallInnerProduct'' Spray a
spray1 Spray a
spray2 = 
  (SimpleParametricQSpray -> Map Partition QSpray)
-> (QSpray -> QSpray -> QSpray)
-> SimpleParametricQSpray
-> SimpleParametricQSpray
-> QSpray
-> QSpray
forall a b.
(C b, C a) =>
(Spray b -> Map Partition b)
-> (a -> b -> b) -> Spray b -> Spray b -> a -> b
_hallInnerProduct 
    ((QSpray -> Rational -> QSpray)
-> SimpleParametricQSpray -> Map Partition QSpray
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination (\QSpray
qspray Rational
r -> Rational
BaseRing QSpray
r BaseRing QSpray -> QSpray -> QSpray
forall b. FunctionLike b => BaseRing b -> b -> b
*^ QSpray
qspray)) QSpray -> QSpray -> QSpray
forall b. (FunctionLike b, C b) => b -> b -> b
(^*^)
    SimpleParametricQSpray
qspray1' SimpleParametricQSpray
qspray2' (Int -> QSpray
qlone Int
1)
  where
    asQSpray :: Spray a -> QSpray
    asQSpray :: Spray a -> QSpray
asQSpray = (a -> Rational) -> Spray a -> QSpray
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Rational
forall a. Real a => a -> Rational
toRational
    qspray1' :: SimpleParametricQSpray
qspray1' = (Rational -> QSpray) -> QSpray -> SimpleParametricQSpray
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Rational -> QSpray
forall a. (Eq a, C a) => a -> Spray a
constantSpray (Spray a -> QSpray
asQSpray Spray a
spray1)
    qspray2' :: SimpleParametricQSpray
qspray2' = (Rational -> QSpray) -> QSpray -> SimpleParametricQSpray
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Rational -> QSpray
forall a. (Eq a, C a) => a -> Spray a
constantSpray (Spray a -> QSpray
asQSpray Spray a
spray2)

-- | Complete symmetric homogeneous polynomial

--

-- >>> putStrLn $ prettyQSpray (cshPolynomial 3 [2, 1])

-- x^3 + 2*x^2.y + 2*x^2.z + 2*x.y^2 + 3*x.y.z + 2*x.z^2 + y^3 + 2*y^2.z + 2*y.z^2 + z^3

cshPolynomial :: (AlgRing.C a, Eq a) 
  => Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> Spray a
cshPolynomial :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
cshPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"cshPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"cshPolynomial: invalid partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda               = Spray a
forall a. C a => Spray a
unitSpray
  | Int
llambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n               = Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise                 = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ((Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Spray a
forall {a}. (C a, Eq a) => Int -> Spray a
cshPolynomialK Partition
lambda)
    where
      llambda :: Int
llambda = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
      cshPolynomialK :: Int -> Spray a
cshPolynomialK Int
k = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
msSprays
        where
          parts :: [Partition]
parts = Int -> [Partition]
partitions Int
k
          msSprays :: [Spray a]
msSprays = 
            [Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomialUnsafe Int
n (Partition -> Partition
fromPartition Partition
part) 
              | Partition
part <- [Partition]
parts, Partition -> Int
partitionWidth Partition
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n]

-- | power sum polynomial as a linear combination of 

-- complete symmetric homogeneous polynomials

pspInCSHbasis :: Partition -> Map Partition Rational
pspInCSHbasis :: Partition -> Map Partition Rational
pspInCSHbasis Partition
mu = 
  (Rational -> Bool)
-> Map Partition Rational -> Map Partition Rational
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0) ([(Partition, Rational)] -> Map Partition Rational
forall k a. [(k, a)] -> Map k a
DM.fromDistinctAscList [(Partition, Rational)]
lambdas_and_weights)
  where
    parts :: [Partition]
parts = Int -> [Partition]
partitions (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu) 
    assoc :: Partition -> (Partition, Rational)
assoc Partition
kappa = 
      let kappa' :: Partition
kappa' = Partition -> Partition
fromPartition Partition
kappa in (Partition
kappa', Partition -> Partition -> Rational
eLambdaMu Partition
kappa' Partition
mu)
    lambdas_and_weights :: [(Partition, Rational)]
lambdas_and_weights = (Partition -> (Partition, Rational))
-> [Partition] -> [(Partition, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> (Partition, Rational)
assoc [Partition]
parts

-- | monomial symmetric polynomial as a linear combination of 

-- complete symmetric homogeneous polynomials

mspInCSHbasis :: Partition -> Map Partition Rational
mspInCSHbasis :: Partition -> Map Partition Rational
mspInCSHbasis Partition
mu = QSpray -> Map Partition Rational
forall a. Spray a -> Map Partition a
sprayToMap ([QSpray] -> QSpray
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [QSpray]
sprays)
  where
    psAssocs :: [(Partition, Rational)]
psAssocs = Map Partition Rational -> [(Partition, Rational)]
forall k a. Map k a -> [(k, a)]
DM.toList (Partition -> Map Partition Rational
mspInPSbasis Partition
mu)
    sprays :: [QSpray]
sprays = 
      [Rational
BaseRing QSpray
c BaseRing QSpray -> QSpray -> QSpray
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Map Partition Rational -> QSpray
forall a. (Eq a, C a) => Map Partition a -> Spray a
comboToSpray (Partition -> Map Partition Rational
pspInCSHbasis Partition
lambda) | (Partition
lambda, Rational
c) <- [(Partition, Rational)]
psAssocs]

-- | symmetric polynomial as a linear combination of 

-- complete symmetric homogeneous polynomials

_cshCombination :: 
  (Eq a, AlgRing.C a) 
  => (a -> Rational -> a) -> Spray a -> Map Partition a
_cshCombination :: forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_cshCombination = (Partition -> Map Partition Rational)
-> (a -> Rational -> a) -> Spray a -> Map Partition a
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination Partition -> Map Partition Rational
mspInCSHbasis

-- | Symmetric polynomial as a linear combination of complete symmetric 

-- homogeneous polynomials. Symmetry is not checked.

cshCombination :: 
  (Eq a, AlgField.C a) => Spray a -> Map Partition a
cshCombination :: forall a. (Eq a, C a) => Spray a -> Map Partition a
cshCombination = 
  (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_cshCombination (\a
coef Rational
r -> a
coef a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* Rational -> a
forall a. C a => Rational -> a
fromRational Rational
r)

-- | Symmetric polynomial as a linear combination of complete symmetric homogeneous polynomials. 

-- Same as @cshCombination@ but with other constraints on the base ring of the spray.

cshCombination' :: 
  (Eq a, AlgMod.C Rational a, AlgRing.C a) 
  => Spray a -> Map Partition a
cshCombination' :: forall a. (Eq a, C Rational a, C a) => Spray a -> Map Partition a
cshCombination' = (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_cshCombination ((Rational -> a -> a) -> a -> Rational -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> a -> a
forall a v. C a v => a -> v -> v
(AlgMod.*>))

-- | Elementary symmetric polynomial.

--

-- >>> putStrLn $ prettyQSpray (esPolynomial 3 [2, 1])

-- x^2.y + x^2.z + x.y^2 + 3*x.y.z + x.z^2 + y^2.z + y.z^2

esPolynomial :: (AlgRing.C a, Eq a) 
  => Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> Spray a
esPolynomial :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
esPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"esPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"esPolynomial: invalid partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda                = Spray a
forall a. C a => Spray a
unitSpray
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n Bool -> Bool -> Bool
|| (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
n) Partition
lambda  = Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise                  = Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
_esPolynomial Int
n Partition
lambda
    where
      l :: Int
l = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda

-- | power sum polynomial as a linear combination of 

-- elementary symmetric polynomials

pspInESbasis :: Partition -> Map Partition Rational
pspInESbasis :: Partition -> Map Partition Rational
pspInESbasis Partition
mu = 
  (Rational -> Bool)
-> Map Partition Rational -> Map Partition Rational
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0) ([(Partition, Rational)] -> Map Partition Rational
forall k a. [(k, a)] -> Map k a
DM.fromDistinctAscList [(Partition, Rational)]
lambdas_and_weights)
  where
    wmu :: Int
wmu = Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu
    parts :: [Partition]
parts = Int -> [Partition]
partitions Int
wmu
    e :: Int
e = Int
wmu Int -> Int -> Int
forall a. Num a => a -> a -> a
- Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
mu
    e_is_even :: Bool
e_is_even = Int -> Bool
forall a. Integral a => a -> Bool
even Int
e
    negateIf :: Rational -> Rational
negateIf = if Bool
e_is_even then Rational -> Rational
forall a. a -> a
id else Rational -> Rational
forall a. Num a => a -> a
negate 
    pair :: Partition -> (Partition, Rational)
pair Partition
kappa = (Partition
kappa, Rational -> Rational
negateIf (Partition -> Partition -> Rational
eLambdaMu Partition
kappa Partition
mu))
    lambdas_and_weights :: [(Partition, Rational)]
lambdas_and_weights = 
      [Partition -> (Partition, Rational)
pair (Partition -> Partition
fromPartition Partition
part) | Partition
part <- [Partition]
parts]

-- | monomial symmetric polynomial as a linear combination of 

-- elementary symmetric polynomials

mspInESbasis :: Partition -> Map Partition Rational
mspInESbasis :: Partition -> Map Partition Rational
mspInESbasis Partition
mu = QSpray -> Map Partition Rational
forall a. Spray a -> Map Partition a
sprayToMap ([QSpray] -> QSpray
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [QSpray]
sprays)
  where
    psAssocs :: [(Partition, Rational)]
psAssocs = Map Partition Rational -> [(Partition, Rational)]
forall k a. Map k a -> [(k, a)]
DM.toList (Partition -> Map Partition Rational
mspInPSbasis Partition
mu)
    sprays :: [QSpray]
sprays = 
      [Rational
BaseRing QSpray
c BaseRing QSpray -> QSpray -> QSpray
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Map Partition Rational -> QSpray
forall a. (Eq a, C a) => Map Partition a -> Spray a
comboToSpray (Partition -> Map Partition Rational
pspInESbasis Partition
lambda) | (Partition
lambda, Rational
c) <- [(Partition, Rational)]
psAssocs]

-- | symmetric polynomial as a linear combination of 

-- elementary symmetric polynomials

_esCombination :: 
  (Eq a, AlgRing.C a) 
  => (a -> Rational -> a) -> Spray a -> Map Partition a
_esCombination :: forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_esCombination = (Partition -> Map Partition Rational)
-> (a -> Rational -> a) -> Spray a -> Map Partition a
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination Partition -> Map Partition Rational
mspInESbasis

-- | Symmetric polynomial as a linear combination of elementary symmetric polynomials. 

-- Symmetry is not checked.

esCombination :: 
  (Eq a, AlgField.C a) => Spray a -> Map Partition a
esCombination :: forall a. (Eq a, C a) => Spray a -> Map Partition a
esCombination = 
  (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_esCombination (\a
coef Rational
r -> a
coef a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* Rational -> a
forall a. C a => Rational -> a
fromRational Rational
r)

-- | Symmetric polynomial as a linear combination of elementary symmetric polynomials. 

-- Same as @esCombination@ but with other constraints on the base ring of the spray.

esCombination' :: 
  (Eq a, AlgMod.C Rational a, AlgRing.C a) 
  => Spray a -> Map Partition a
esCombination' :: forall a. (Eq a, C Rational a, C a) => Spray a -> Map Partition a
esCombination' = (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_esCombination ((Rational -> a -> a) -> a -> Rational -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> a -> a
forall a v. C a v => a -> v -> v
(AlgMod.*>))

-- | complete symmetric homogeneous polynomial as a linear combination of 

-- Schur polynomials

cshInSchurBasis :: Int -> Partition -> Map Partition Int
cshInSchurBasis :: Int -> Partition -> Map Partition Int
cshInSchurBasis Int
n Partition
mu = 
  (Partition -> Int -> Bool)
-> Map Partition Int -> Map Partition Int
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
DM.filterWithKey (\Partition
k Int
_ -> Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) 
                    ((Partition -> Partition) -> Map Partition Int -> Map Partition Int
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
DM.mapKeys Partition -> Partition
fromPartition Map Partition Int
kNumbers)
  where
    kNumbers :: Map Partition Int
kNumbers = Partition -> Map Partition Int
kostkaNumbersWithGivenMu (Partition -> Partition
toPartitionUnsafe Partition
mu)

-- | symmetric polynomial as a linear combination of Schur polynomials

_schurCombination :: 
  forall a. (Eq a, AlgRing.C a) 
  => (a -> Rational -> a) -> Spray a -> Map Partition a
_schurCombination :: forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_schurCombination a -> Rational -> a
func Spray a
spray =
  if a
constantTerm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero 
    then Map Partition a
schurMap
    else Partition -> a -> Map Partition a -> Map Partition a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [] a
constantTerm Map Partition a
schurMap
  where
    constantTerm :: a
constantTerm = Spray a -> a
forall a. C a => Spray a -> a
getConstantTerm Spray a
spray
    cshCombo :: Map Partition a
cshCombo = 
      (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_cshCombination a -> Rational -> a
func (Spray a
spray Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ (a -> a
forall a. C a => a -> a
AlgAdd.negate a
constantTerm))
    f :: Partition -> a -> Map Partition a
    f :: Partition -> a -> Map Partition a
f Partition
lambda a
coeff = 
      (Int -> a) -> Map Partition Int -> Map Partition a
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map ((a -> Rational -> a
func a
coeff) (Rational -> a) -> (Int -> Rational) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational
forall a. Real a => a -> Rational
toRational) Map Partition Int
schurCombo
      where
        schurCombo :: Map Partition Int
schurCombo = Int -> Partition -> Map Partition Int
cshInSchurBasis (Spray a -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables Spray a
spray) Partition
lambda 
    schurMap :: Map Partition a
schurMap = 
      (a -> Bool) -> Map Partition a -> Map Partition a
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. C a => a
AlgAdd.zero) 
        ((Map Partition a -> Partition -> a -> Map Partition a)
-> Map Partition a -> Map Partition a -> Map Partition a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
DM.foldlWithKey' 
          (\Map Partition a
m Partition
lambda a
coeff -> (a -> a -> a)
-> Map Partition a -> Map Partition a -> Map Partition a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
DM.unionWith a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) Map Partition a
m (Partition -> a -> Map Partition a
f Partition
lambda a
coeff)) 
            Map Partition a
forall k a. Map k a
DM.empty Map Partition a
cshCombo)

-- | Symmetric polynomial as a linear combination of Schur polynomials. 

-- Symmetry is not checked.

schurCombination :: 
  (Eq a, AlgField.C a) => Spray a -> Map Partition a
schurCombination :: forall a. (Eq a, C a) => Spray a -> Map Partition a
schurCombination = 
  (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_schurCombination (\a
coef Rational
r -> a
coef a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* Rational -> a
forall a. C a => Rational -> a
fromRational Rational
r)

-- | Symmetric polynomial as a linear combination of Schur polynomials. 

-- Same as @schurCombination@ but with other constraints on the base ring of the spray.

schurCombination' :: 
  (Eq a, AlgMod.C Rational a, AlgRing.C a) 
  => Spray a -> Map Partition a
schurCombination' :: forall a. (Eq a, C Rational a, C a) => Spray a -> Map Partition a
schurCombination' = (a -> Rational -> a) -> Spray a -> Map Partition a
forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_schurCombination ((Rational -> a -> a) -> a -> Rational -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> a -> a
forall a v. C a v => a -> v -> v
(AlgMod.*>))

-- | monomial symmetric polynomials in Jack polynomials basis

msPolynomialsInJackBasis :: 
  (Eq a, AlgField.C a)
  => a -> Char -> Int -> Int -> Map Partition (Map Partition a)
msPolynomialsInJackBasis :: forall a.
(Eq a, C a) =>
a -> Char -> Int -> Int -> Map Partition (Map Partition a)
msPolynomialsInJackBasis a
alpha Char
which Int
n Int
weight = 
   Int -> Int -> a -> Char -> Map Partition (Map Partition a)
forall a.
(Eq a, C a) =>
Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_inverseKostkaMatrix Int
n Int
weight a
alpha Char
which

-- | monomial symmetric polynomials in Jack polynomials basis

msPolynomialsInJackSymbolicBasis :: 
  (Eq a, AlgField.C a) 
  => Char -> Int -> Int -> Map Partition (Map Partition (RatioOfSprays a))
msPolynomialsInJackSymbolicBasis :: forall a.
(Eq a, C a) =>
Char
-> Int -> Int -> Map Partition (Map Partition (RatioOfSprays a))
msPolynomialsInJackSymbolicBasis Char
which Int
n Int
weight = 
  Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
forall a.
(Eq a, C a) =>
Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_inverseSymbolicKostkaMatrix Int
n Int
weight Char
which

-- | Symmetric polynomial as a linear combination of Jack polynomials with a 

-- given Jack parameter. Symmetry is not checked.

jackCombination :: 
  (Eq a, AlgField.C a)
  => a                      -- ^ Jack parameter

  -> Char                   -- ^ which Jack polynomials, @'J'@, @'C'@, @'P'@ or @'Q'@

  -> Spray a                -- ^ spray representing a symmetric polynomial

  -> Map Partition a        -- ^ map representing the linear combination; a partition @lambda@ in the keys of this map corresponds to the term @coeff *^ jackPol' n lambda alpha which@, where @coeff@ is the value attached to this key and @n@ is the number of variables of the spray

jackCombination :: forall a. (Eq a, C a) => a -> Char -> Spray a -> Map Partition a
jackCombination a
alpha Char
which Spray a
spray = 
  if Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'J', Char
'C', Char
'P', Char
'Q']) 
    then [Char] -> Map Partition a
forall a. HasCallStack => [Char] -> a
error [Char]
"jackCombination: invalid character, must be 'J', 'C', 'P' or 'Q'."
    else
      (Partition -> Map Partition a)
-> (a -> a -> a) -> Spray a -> Map Partition a
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination 
        (\Partition
lambda -> (IntMap (Map Partition (Map Partition a))
combos IntMap (Map Partition (Map Partition a))
-> Int -> Map Partition (Map Partition a)
forall a. IntMap a -> Int -> a
IM.! (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda)) Map Partition (Map Partition a) -> Partition -> Map Partition a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda) 
          a -> a -> a
forall a. C a => a -> a -> a
(AlgRing.*) Spray a
spray
  where
    weights :: Partition
weights = (Int -> Bool) -> Partition -> Partition
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ((Seq Int -> Int) -> [Seq Int] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum (Spray a -> [Seq Int]
forall a. Spray a -> [Seq Int]
allExponents Spray a
spray))
    n :: Int
n = Spray a -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables Spray a
spray
    combos :: IntMap (Map Partition (Map Partition a))
combos = 
      [(Int, Map Partition (Map Partition a))]
-> IntMap (Map Partition (Map Partition a))
forall a. [(Int, a)] -> IntMap a
IM.fromList 
        (Partition
-> [Map Partition (Map Partition a)]
-> [(Int, Map Partition (Map Partition a))]
forall a b. [a] -> [b] -> [(a, b)]
zip Partition
weights ((Int -> Map Partition (Map Partition a))
-> Partition -> [Map Partition (Map Partition a)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Char -> Int -> Int -> Map Partition (Map Partition a)
forall a.
(Eq a, C a) =>
a -> Char -> Int -> Int -> Map Partition (Map Partition a)
msPolynomialsInJackBasis a
alpha Char
which Int
n) Partition
weights))

-- | Symmetric parametric polynomial as a linear combination of Jack 

-- polynomials with a given Jack parameter. Symmetry is not checked.

-- Similar to @jackCombination@ but for a parametric spray.

jackCombination' :: 
    (FunctionLike b, Eq b, AlgRing.C b, Eq (BaseRing b), AlgField.C (BaseRing b))
  => BaseRing b             -- ^ Jack parameter

  -> Char                   -- ^ which Jack polynomials, @'J'@, @'C'@, @'P'@ or @'Q'@

  -> Spray b                -- ^ parametric spray representing a symmetric polynomial

  -> Map Partition b  
jackCombination' :: forall b.
(FunctionLike b, Eq b, C b, Eq (BaseRing b), C (BaseRing b)) =>
BaseRing b -> Char -> Spray b -> Map Partition b
jackCombination' BaseRing b
alpha Char
which Spray b
spray = 
  if Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'J', Char
'C', Char
'P', Char
'Q']) 
    then [Char] -> Map Partition b
forall a. HasCallStack => [Char] -> a
error [Char]
"jackCombination': invalid character, must be 'J', 'C', 'P' or 'Q'."
    else
      (Partition -> Map Partition (BaseRing b))
-> (b -> BaseRing b -> b) -> Spray b -> Map Partition b
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination 
        (\Partition
lambda -> (IntMap (Map Partition (Map Partition (BaseRing b)))
combos IntMap (Map Partition (Map Partition (BaseRing b)))
-> Int -> Map Partition (Map Partition (BaseRing b))
forall a. IntMap a -> Int -> a
IM.! (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda)) Map Partition (Map Partition (BaseRing b))
-> Partition -> Map Partition (BaseRing b)
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda) 
          ((BaseRing b -> b -> b) -> b -> BaseRing b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip BaseRing b -> b -> b
forall b. FunctionLike b => BaseRing b -> b -> b
(*^)) Spray b
spray
  where
    weights :: Partition
weights = (Int -> Bool) -> Partition -> Partition
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ((Seq Int -> Int) -> [Seq Int] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum (Spray b -> [Seq Int]
forall a. Spray a -> [Seq Int]
allExponents Spray b
spray))
    n :: Int
n = Spray b -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables Spray b
spray
    combos :: IntMap (Map Partition (Map Partition (BaseRing b)))
combos = 
      [(Int, Map Partition (Map Partition (BaseRing b)))]
-> IntMap (Map Partition (Map Partition (BaseRing b)))
forall a. [(Int, a)] -> IntMap a
IM.fromList 
        (Partition
-> [Map Partition (Map Partition (BaseRing b))]
-> [(Int, Map Partition (Map Partition (BaseRing b)))]
forall a b. [a] -> [b] -> [(a, b)]
zip Partition
weights ((Int -> Map Partition (Map Partition (BaseRing b)))
-> Partition -> [Map Partition (Map Partition (BaseRing b))]
forall a b. (a -> b) -> [a] -> [b]
map (BaseRing b
-> Char -> Int -> Int -> Map Partition (Map Partition (BaseRing b))
forall a.
(Eq a, C a) =>
a -> Char -> Int -> Int -> Map Partition (Map Partition a)
msPolynomialsInJackBasis BaseRing b
alpha Char
which Int
n) Partition
weights))

-- | Symmetric polynomial as a linear combination of Jack polynomials with 

-- symbolic parameter. Symmetry is not checked.

jackSymbolicCombination :: 
     Char                   -- ^ which Jack polynomials, @'J'@, @'C'@, @'P'@ or @'Q'@

  -> QSpray                 -- ^ spray representing a symmetric polynomial

  -> Map Partition RatioOfQSprays -- ^ map representing the linear combination; a partition @lambda@ in the keys of this map corresponds to the term @coeff *^ jackSymbolicPol' n lambda which@, where @coeff@ is the value attached to this key and @n@ is the number of variables of the spray

jackSymbolicCombination :: Char -> QSpray -> Map Partition RatioOfQSprays
jackSymbolicCombination Char
which QSpray
qspray = 
  if Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'J', Char
'C', Char
'P', Char
'Q']) 
    then [Char] -> Map Partition RatioOfQSprays
forall a. HasCallStack => [Char] -> a
error [Char]
"jackSymbolicCombination: invalid character, must be 'J', 'C', 'P' or 'Q'."
    else (Partition -> Map Partition RatioOfQSprays)
-> (RatioOfQSprays -> RatioOfQSprays -> RatioOfQSprays)
-> ParametricQSpray
-> Map Partition RatioOfQSprays
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination 
      (\Partition
lambda -> (IntMap (Map Partition (Map Partition RatioOfQSprays))
combos IntMap (Map Partition (Map Partition RatioOfQSprays))
-> Int -> Map Partition (Map Partition RatioOfQSprays)
forall a. IntMap a -> Int -> a
IM.! (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda)) Map Partition (Map Partition RatioOfQSprays)
-> Partition -> Map Partition RatioOfQSprays
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda) 
        RatioOfQSprays -> RatioOfQSprays -> RatioOfQSprays
forall a. C a => a -> a -> a
(AlgRing.*) ((Rational -> RatioOfQSprays) -> QSpray -> ParametricQSpray
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Rational -> RatioOfQSprays
forall a. (Eq a, C a) => a -> RatioOfSprays a
constantRatioOfSprays QSpray
qspray)
  where
    weights :: Partition
weights = (Int -> Bool) -> Partition -> Partition
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ((Seq Int -> Int) -> [Seq Int] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum (QSpray -> [Seq Int]
forall a. Spray a -> [Seq Int]
allExponents QSpray
qspray))
    n :: Int
n = QSpray -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables QSpray
qspray
    combos :: IntMap (Map Partition (Map Partition RatioOfQSprays))
combos = 
      [(Int, Map Partition (Map Partition RatioOfQSprays))]
-> IntMap (Map Partition (Map Partition RatioOfQSprays))
forall a. [(Int, a)] -> IntMap a
IM.fromList 
      (Partition
-> [Map Partition (Map Partition RatioOfQSprays)]
-> [(Int, Map Partition (Map Partition RatioOfQSprays))]
forall a b. [a] -> [b] -> [(a, b)]
zip Partition
weights ((Int -> Map Partition (Map Partition RatioOfQSprays))
-> Partition -> [Map Partition (Map Partition RatioOfQSprays)]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Int -> Int -> Map Partition (Map Partition RatioOfQSprays)
forall a.
(Eq a, C a) =>
Char
-> Int -> Int -> Map Partition (Map Partition (RatioOfSprays a))
msPolynomialsInJackSymbolicBasis Char
which Int
n) Partition
weights))

-- | Symmetric parametric polynomial as a linear combination of Jack polynomials 

-- with symbolic parameter. 

-- Similar to @jackSymbolicCombination@ but for a parametric spray.

jackSymbolicCombination' :: 
    (Eq a, AlgField.C a)
  => Char                            -- ^ which Jack polynomials, @'J'@, @'C'@, @'P'@ or @'Q'@

  -> ParametricSpray a               -- ^ parametric spray representing a symmetric polynomial

  -> Map Partition (RatioOfSprays a) -- ^ map representing the linear combination; a partition @lambda@ in the keys of this map corresponds to the term @coeff *^ jackSymbolicPol' n lambda which@, where @coeff@ is the value attached to this key and @n@ is the number of variables of the spray

jackSymbolicCombination' :: forall a.
(Eq a, C a) =>
Char -> ParametricSpray a -> Map Partition (RatioOfSprays a)
jackSymbolicCombination' Char
which ParametricSpray a
spray = 
  if Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'J', Char
'C', Char
'P', Char
'Q']) 
    then [Char] -> Map Partition (RatioOfSprays a)
forall a. HasCallStack => [Char] -> a
error [Char]
"jackSymbolicCombination': invalid character, must be 'J', 'C', 'P' or 'Q'."
    else (Partition -> Map Partition (RatioOfSprays a))
-> (RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a)
-> ParametricSpray a
-> Map Partition (RatioOfSprays a)
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination 
      (\Partition
lambda -> (IntMap (Map Partition (Map Partition (RatioOfSprays a)))
combos IntMap (Map Partition (Map Partition (RatioOfSprays a)))
-> Int -> Map Partition (Map Partition (RatioOfSprays a))
forall a. IntMap a -> Int -> a
IM.! (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda)) Map Partition (Map Partition (RatioOfSprays a))
-> Partition -> Map Partition (RatioOfSprays a)
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda) 
        RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
(AlgRing.*) ParametricSpray a
spray
  where
    weights :: Partition
weights = (Int -> Bool) -> Partition -> Partition
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ((Seq Int -> Int) -> [Seq Int] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum (ParametricSpray a -> [Seq Int]
forall a. Spray a -> [Seq Int]
allExponents ParametricSpray a
spray))
    n :: Int
n = ParametricSpray a -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables ParametricSpray a
spray
    combos :: IntMap (Map Partition (Map Partition (RatioOfSprays a)))
combos = 
      [(Int, Map Partition (Map Partition (RatioOfSprays a)))]
-> IntMap (Map Partition (Map Partition (RatioOfSprays a)))
forall a. [(Int, a)] -> IntMap a
IM.fromList 
      (Partition
-> [Map Partition (Map Partition (RatioOfSprays a))]
-> [(Int, Map Partition (Map Partition (RatioOfSprays a)))]
forall a b. [a] -> [b] -> [(a, b)]
zip Partition
weights ((Int -> Map Partition (Map Partition (RatioOfSprays a)))
-> Partition -> [Map Partition (Map Partition (RatioOfSprays a))]
forall a b. (a -> b) -> [a] -> [b]
map (Char
-> Int -> Int -> Map Partition (Map Partition (RatioOfSprays a))
forall a.
(Eq a, C a) =>
Char
-> Int -> Int -> Map Partition (Map Partition (RatioOfSprays a))
msPolynomialsInJackSymbolicBasis Char
which Int
n) Partition
weights))

-- | symmetric simple parametric spray as a linear combination of 

-- Hall-Littlewood P-polynomials 

hlpCombination :: 
  SimpleParametricQSpray -> Map Partition QSpray    
hlpCombination :: SimpleParametricQSpray -> Map Partition QSpray
hlpCombination SimpleParametricQSpray
spray = 
  (Partition -> Map Partition QSpray)
-> (QSpray -> QSpray -> QSpray)
-> SimpleParametricQSpray
-> Map Partition QSpray
forall a b.
(Eq a, C a) =>
(Partition -> Map Partition b)
-> (a -> b -> a) -> Spray a -> Map Partition a
_symmPolyCombination 
    (\Partition
lambda -> Int -> Partition -> Map Partition QSpray
_msPolynomialInHLPbasis Int
n Partition
lambda) 
      QSpray -> QSpray -> QSpray
forall a. C a => a -> a -> a
(AlgRing.*) SimpleParametricQSpray
spray
  where
    n :: Int
n = SimpleParametricQSpray -> Int
forall b. FunctionLike b => b -> Int
numberOfVariables SimpleParametricQSpray
spray

-- | Hall polynomials \(g^{\lambda}_{\mu,\nu}(t)\) for given integer partitions

-- \(\mu\) and \(\nu\). The keys of the map returned by this function are the 

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

-- Hall polynomial \(g^{\lambda}_{\mu,\nu}(t)\) (it is given as a @QSpray@ 

-- spray but actually all its coefficients are integer). __Warning:__ slow.

hallPolynomials ::
     Partition -- ^ the integer partition \(\mu\)

  -> Partition -- ^ the integer partition \(\nu\)

  -> Map Partition QSpray
hallPolynomials :: Partition -> Partition -> Map Partition QSpray
hallPolynomials Partition
mu Partition
nu 
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
mu) =
      [Char] -> Map Partition QSpray
forall a. HasCallStack => [Char] -> a
error [Char]
"hallPolynomials: invalid integer partition `mu`."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
nu) =
      [Char] -> Map Partition QSpray
forall a. HasCallStack => [Char] -> a
error [Char]
"hallPolynomials: invalid integer partition `nu`."
  | Bool
otherwise =
      (Partition -> QSpray -> QSpray)
-> Map Partition QSpray -> Map Partition QSpray
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey Partition -> QSpray -> QSpray
f
        (SimpleParametricQSpray -> Map Partition QSpray
hlpCombination 
          (Int -> Partition -> Char -> SimpleParametricQSpray
hallLittlewoodPolynomial' Int
n Partition
mu Char
'P' 
            SimpleParametricQSpray
-> SimpleParametricQSpray -> SimpleParametricQSpray
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Int -> Partition -> Char -> SimpleParametricQSpray
hallLittlewoodPolynomial' Int
n Partition
nu Char
'P'))
  where
    n :: Int
n = Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
nu
    _n :: Partition -> Int
    _n :: Partition -> Int
_n Partition
lambda = Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Int -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) [Int
1 .. ] (Partition -> Partition
forall a. [a] -> [a]
drop1 Partition
lambda))
    _n_mu_nu :: Int
_n_mu_nu = Partition -> Int
_n Partition
mu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Partition -> Int
_n Partition
nu
    t :: Int -> QSpray
t = Int -> Int -> QSpray
qlone' Int
1
    invt :: RatioOfQSprays
invt = QSpray -> QSpray -> RatioOfQSprays
forall a. Spray a -> Spray a -> RatioOfSprays a
RatioOfSprays QSpray
forall a. C a => Spray a
unitSpray (Int -> QSpray
qlone Int
1)
    f :: Partition -> QSpray -> QSpray
    f :: Partition -> QSpray -> QSpray
f Partition
lambda QSpray
spray = 
      RatioOfQSprays -> QSpray
forall a. RatioOfSprays a -> Spray a
_numerator (RatioOfQSprays -> QSpray) -> RatioOfQSprays -> QSpray
forall a b. (a -> b) -> a -> b
$ 
        (Int -> QSpray
t (Partition -> Int
_n Partition
lambda Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_n_mu_nu)) 
          QSpray -> RatioOfQSprays -> RatioOfQSprays
forall a v. C a v => a -> v -> v
AlgMod.*> (RatioOfQSprays -> [RatioOfQSprays] -> RatioOfQSprays
forall a.
(Eq a, C a) =>
RatioOfSprays a -> [RatioOfSprays a] -> RatioOfSprays a
evalRatioOfSprays' (QSpray -> RatioOfQSprays
forall a. C a => Spray a -> RatioOfSprays a
asRatioOfSprays QSpray
spray) [RatioOfQSprays
invt])

-- | Kostka-Foulkes polynomial of two given partitions. This is a univariate 

-- polynomial whose value at @1@ is the Kostka number of the two partitions.

kostkaFoulkesPolynomial :: 
  (Eq a, AlgRing.C a) => Partition -> Partition -> Spray a
kostkaFoulkesPolynomial :: forall a. (Eq a, C a) => Partition -> Partition -> Spray a
kostkaFoulkesPolynomial Partition
lambda Partition
mu 
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"kostkaFoulkesPolynomial: invalid partition."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
mu)     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"kostkaFoulkesPolynomial: invalid partition."
  | Bool
otherwise                 = 
      Partition -> Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Partition -> Spray a
_kostkaFoulkesPolynomial Partition
lambda Partition
mu

-- | Kostka-Foulkes polynomial of two given partitions. This is a univariate 

-- polynomial whose value at @1@ is the Kostka number of the two partitions.

kostkaFoulkesPolynomial' :: Partition -> Partition -> QSpray
kostkaFoulkesPolynomial' :: Partition -> Partition -> QSpray
kostkaFoulkesPolynomial' = Partition -> Partition -> QSpray
forall a. (Eq a, C a) => Partition -> Partition -> Spray a
kostkaFoulkesPolynomial

-- | Skew Kostka-Foulkes polynomial. This is a univariate polynomial associated

-- to a skew partition and a partition, and its value at @1@ is the skew Kostka 

-- number associated to these partitions.

skewKostkaFoulkesPolynomial :: 
  (Eq a, AlgRing.C a) 
  => Partition -- ^ outer partition of the skew partition

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

  -> Partition -- ^ integer partition; the equality of the weight of this partition with the weight of the skew partition is a necessary condition to get a non-zero polynomial

  -> Spray a
skewKostkaFoulkesPolynomial :: forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Spray a
skewKostkaFoulkesPolynomial Partition
lambda Partition
mu Partition
nu 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
     [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewKostkaFoulkesPolynomial: invalid skew partition."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
nu) =
     [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewKostkaFoulkesPolynomial: invalid partition."
  | Bool
otherwise = 
      Partition -> Partition -> Partition -> Spray a
forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Spray a
_skewKostkaFoulkesPolynomial Partition
lambda Partition
mu Partition
nu

-- | Skew Kostka-Foulkes polynomial. This is a univariate polynomial associated

-- to a skew partition and a partition, and its value at @1@ is the skew Kostka 

-- number associated to these partitions.

skewKostkaFoulkesPolynomial' :: 
     Partition -- ^ outer partition of the skew partition

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

  -> Partition -- ^ integer partition; the equality of the weight of this partition with the weight of the skew partition is a necessary condition to get a non-zero polynomial

  -> QSpray
skewKostkaFoulkesPolynomial' :: Partition -> Partition -> Partition -> QSpray
skewKostkaFoulkesPolynomial' = Partition -> Partition -> Partition -> QSpray
forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Spray a
skewKostkaFoulkesPolynomial 

-- | qt-Kostka polynomials, aka Kostka-Macdonald polynomials. These are bivariate

-- polynomials usually denoted by \(K_{\lambda, \mu}(q,t)\) for two 

-- integer partitions \(\lambda\) and \(mu\), and \(q\) and \(t\) denote the 

-- variables. One obtains the Kostka-Foulkes polynomials by substituting \(q\) 

-- with \(0\). For a given partition \(\mu\), the function returns the polynomials

-- \(K_{\lambda, \mu}(q,t)\) for all partitions \(\lambda\) of the same weight as 

-- \(\mu\).

qtKostkaPolynomials :: 
  (Eq a, AlgField.C a) 
  => Partition 
  -> Map Partition (Spray a) 
qtKostkaPolynomials :: forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
qtKostkaPolynomials Partition
mu 
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
mu) =
      [Char] -> Map Partition (Spray a)
forall a. HasCallStack => [Char] -> a
error [Char]
"qtKostkaPolynomials: invalid integer partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
mu =
      Partition -> Spray a -> Map Partition (Spray a)
forall k a. k -> a -> Map k a
DM.singleton [] Spray a
forall a. C a => Spray a
unitSpray
  | Bool
otherwise = 
      (RatioOfSprays a -> Spray a)
-> Map Partition (RatioOfSprays a) -> Map Partition (Spray a)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map RatioOfSprays a -> Spray a
forall a. RatioOfSprays a -> Spray a
_numerator Map Partition (RatioOfSprays a)
scs 
  where
    psCombo :: Map Partition (Spray a)
psCombo = Partition -> Map Partition (Spray a)
forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
macdonaldJinPSbasis Partition
mu
    t :: Int -> Spray a
t = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
2 
    den :: Partition -> Spray a
den Partition
lambda = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Spray a
forall a. C a => Spray a
unitSpray Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Int -> Spray a
t Int
k | Int
k <- Partition
lambda]
    msCombo :: Partition -> Map Partition a
msCombo Partition
lambda = 
      Spray a -> Map Partition a
forall a. C a => Spray a -> Map Partition a
msCombination (Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
psPolynomial (Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda) Partition
lambda)
    ikn :: Map Partition (Map Partition Int)
ikn = Int -> Map Partition (Map Partition Int)
inverseKostkaNumbers (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu)
    coeffs :: Partition -> Map Partition Int
coeffs Partition
lambda = 
      let combo :: Map Partition Int
combo = Partition -> Map Partition Int
forall {a}. (C a, Eq a) => Partition -> Map Partition a
msCombo Partition
lambda in
        (Map Partition Int -> Int)
-> Map Partition (Map Partition Int) -> Map Partition Int
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map 
          (\Map Partition Int
ikNumbers -> 
            Map Partition Int -> Int
forall a. Num a => Map Partition a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum (Map Partition Int -> Int) -> Map Partition Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Map Partition Int -> Map Partition Int -> Map Partition Int
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
DM.intersectionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) Map Partition Int
combo Map Partition Int
ikNumbers) 
          Map Partition (Map Partition Int)
ikn
    scs :: Map Partition (RatioOfSprays a)
scs = (Map Partition (RatioOfSprays a)
 -> Partition -> Spray a -> Map Partition (RatioOfSprays a))
-> Map Partition (RatioOfSprays a)
-> Map Partition (Spray a)
-> Map Partition (RatioOfSprays a)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
DM.foldlWithKey
      (\Map Partition (RatioOfSprays a)
m Partition
lambda Spray a
c -> 
        let den_lambda :: Spray a
den_lambda = Partition -> Spray a
den Partition
lambda in
          (RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
DM.unionWith RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
(AlgAdd.+) Map Partition (RatioOfSprays a)
m 
            ((Int -> RatioOfSprays a)
-> Map Partition Int -> Map Partition (RatioOfSprays a)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map 
              (\Int
ikNumber -> (Int
ikNumber Int -> Spray a -> Spray a
forall a. (C a, Eq a) => Int -> a -> a
.^ Spray a
c) Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% Spray a
den_lambda) 
                (Partition -> Map Partition Int
coeffs Partition
lambda)
            )
      )
      Map Partition (RatioOfSprays a)
forall k a. Map k a
DM.empty Map Partition (Spray a)
psCombo

-- | qt-Kostka polynomials, aka Kostka-Macdonald polynomials. These are bivariate

-- polynomials usually denoted by \(K_{\lambda, \mu}(q,t)\) for two 

-- integer partitions \(\lambda\) and \(mu\), and \(q\) and \(t\) denote the 

-- variables. One obtains the Kostka-Foulkes polynomials by substituting \(q\) 

-- with \(0\). For a given partition \(\mu\), the function returns the polynomials

-- \(K_{\lambda, \mu}(q,t)\) for all partitions \(\lambda\) of the same weight as 

-- \(\mu\).

qtKostkaPolynomials' :: 
     Partition 
  -> Map Partition QSpray
qtKostkaPolynomials' :: Partition -> Map Partition QSpray
qtKostkaPolynomials' = Partition -> Map Partition QSpray
forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
qtKostkaPolynomials

-- | Skew qt-Kostka polynomials. These are bivariate

-- polynomials usually denoted by \(K_{\lambda/\mu, \nu}(q,t)\) for two 

-- integer partitions \(\lambda\) and \(mu\) defining a skew partition, an 

-- integer partition \(\nu\), and \(q\) and \(t\) denote the 

-- variables. One obtains the skew Kostka-Foulkes polynomials by substituting \(q\) 

-- with \(0\). For given partitions \(\lambda\) and \(\mu\), the function returns 

-- the polynomials \(K_{\lambda/\mu, \nu}(q,t)\) for all partitions \(\nu\) of the 

-- same weight as the skew partition.

qtSkewKostkaPolynomials :: 
  (Eq a, AlgField.C a) 
  => Partition -- ^ outer partition of the skew partition

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

  -> Map Partition (Spray a)
qtSkewKostkaPolynomials :: forall a.
(Eq a, C a) =>
Partition -> Partition -> Map Partition (Spray a)
qtSkewKostkaPolynomials Partition
lambda Partition
mu 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
      [Char] -> Map Partition (Spray a)
forall a. HasCallStack => [Char] -> a
error [Char]
"qtSkewKostkaPolynomials: invalid skew partition."
  | Partition
lambda Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
mu =
      Partition -> Spray a -> Map Partition (Spray a)
forall k a. k -> a -> Map k a
DM.singleton [] Spray a
forall a. C a => Spray a
unitSpray
  | Bool
otherwise = 
      [(Partition, Spray a)] -> Map Partition (Spray a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctAscList ((Partition -> (Partition, Spray a))
-> [Partition] -> [(Partition, Spray a)]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> (Partition, Spray a)
forall {a}. (Eq a, C a) => Partition -> (Partition, Spray a)
spray [Partition]
nus)
  where
    lrCoeffs :: Map Partition Int
lrCoeffs = Partition -> Partition -> Map Partition Int
skewSchurLRCoefficients Partition
lambda Partition
mu
    nus :: [Partition]
nus = Int -> [Partition]
partitions (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda Int -> Int -> Int
forall a. Num a => a -> a -> a
- Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu)
    spray :: Partition -> (Partition, Spray a)
spray Partition
nu = 
      let nu' :: Partition
nu' = Partition -> Partition
fromPartition Partition
nu in
        (
          Partition
nu',
          (Spray a -> Spray a -> Spray a)
-> Spray a -> Map Partition (Spray a) -> Spray a
forall b a. (b -> a -> b) -> b -> Map Partition a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
(^+^) 
              Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
                ((Int -> Spray a -> Spray a)
-> Map Partition Int
-> Map Partition (Spray a)
-> Map Partition (Spray a)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
DM.intersectionWith Int -> Spray a -> Spray a
forall a. (C a, Eq a) => Int -> a -> a
(.^) Map Partition Int
lrCoeffs (Partition -> Map Partition (Spray a)
forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
qtKostkaPolynomials Partition
nu'))
        )

-- | Skew qt-Kostka polynomials. These are bivariate

-- polynomials usually denoted by \(K_{\lambda/\mu, \nu}(q,t)\) for two 

-- integer partitions \(\lambda\) and \(mu\) defining a skew partition, an 

-- integer partition \(\nu\), and \(q\) and \(t\) denote the 

-- variables. One obtains the skew Kostka-Foulkes polynomials by substituting \(q\) 

-- with \(0\). For given partitions \(\lambda\) and \(\mu\), the function returns 

-- the polynomials \(K_{\lambda/\mu, \nu}(q,t)\) for all partitions \(\nu\) of the 

-- same weight as the skew partition.

qtSkewKostkaPolynomials' :: 
     Partition -- ^ outer partition of the skew partition

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

  -> Map Partition QSpray
qtSkewKostkaPolynomials' :: Partition -> Partition -> Map Partition QSpray
qtSkewKostkaPolynomials' = Partition -> Partition -> Map Partition QSpray
forall a.
(Eq a, C a) =>
Partition -> Partition -> Map Partition (Spray a)
qtSkewKostkaPolynomials

-- | Hall-Littlewood polynomial of a given partition. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in a single parameter

-- usually denoted by \(t\). When substituting \(t\) with \(0\) in the 

-- Hall-Littlewood \(P\)-polynomials, one obtains the Schur polynomials.

hallLittlewoodPolynomial :: 
  (Eq a, AlgRing.C a) 
  => Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> Char      -- ^ which Hall-Littlewood polynomial, @'P'@ or @'Q'@

  -> SimpleParametricSpray a
hallLittlewoodPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> SimpleParametricSpray a
hallLittlewoodPolynomial Int
n Partition
lambda Char
which 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"hallLittlewoodPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"hallLittlewoodPolynomial: invalid partition."
  | Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'P', Char
'Q']) =
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"hallLittlewoodPolynomial: last argument must be 'P' or 'Q'."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda = 
      SimpleParametricSpray a
forall a. C a => Spray a
unitSpray
  | Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = 
      SimpleParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = [SimpleParametricSpray a] -> SimpleParametricSpray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [SimpleParametricSpray a]
sprays
    where
      coeffs :: Map Partition (Spray a)
coeffs = Char -> Partition -> Map Partition (Spray a)
forall a.
(Eq a, C a) =>
Char -> Partition -> Map Partition (Spray a)
_hallLittlewoodPolynomialsInSchurBasis Char
which Partition
lambda
      sprays :: [SimpleParametricSpray a]
sprays = 
        Map Partition (SimpleParametricSpray a)
-> [SimpleParametricSpray a]
forall k a. Map k a -> [a]
DM.elems 
          ((Partition -> Spray a -> SimpleParametricSpray a)
-> Map Partition (Spray a)
-> Map Partition (SimpleParametricSpray a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey 
            (\Partition
mu Spray a
c -> BaseRing (SimpleParametricSpray a)
Spray a
c BaseRing (SimpleParametricSpray a)
-> SimpleParametricSpray a -> SimpleParametricSpray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ ((a -> Spray a) -> Spray a -> SimpleParametricSpray a
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Spray a
forall a. (Eq a, C a) => a -> Spray a
constantSpray (Int -> Partition -> Spray a
forall a. (Eq a, C a) => Int -> Partition -> Spray a
schurPol Int
n Partition
mu))) Map Partition (Spray a)
coeffs)

-- | Hall-Littlewood polynomial of a given partition. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in a single parameter

-- usually denoted by \(t\). When substituting \(t\) with \(0\) in the 

-- Hall-Littlewood \(P\)-polynomials, one obtains the Schur polynomials.

hallLittlewoodPolynomial' :: 
     Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> Char      -- ^ which Hall-Littlewood polynomial, @'P'@ or @'Q'@

  -> SimpleParametricQSpray
hallLittlewoodPolynomial' :: Int -> Partition -> Char -> SimpleParametricQSpray
hallLittlewoodPolynomial' = Int -> Partition -> Char -> SimpleParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> SimpleParametricSpray a
hallLittlewoodPolynomial

-- | Hall-Littlewood polynomials as linear combinations of Schur polynomials.

transitionsSchurToHallLittlewood :: 
     Int   -- ^ weight of the partitions of the Hall-Littlewood polynomials

  -> Char  -- ^ which Hall-Littlewood polynomials, @'P'@ or @'Q'@

  -> Map Partition (Map Partition (Spray Int))
transitionsSchurToHallLittlewood :: Int -> Char -> Map Partition (Map Partition (Spray Int))
transitionsSchurToHallLittlewood Int
weight Char
which 
  | Int
weight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                   = 
      [Char] -> Map Partition (Map Partition (Spray Int))
forall a. HasCallStack => [Char] -> a
error [Char]
"transitionsHallLittlewoodToSchur: negative weight."
  | Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'P', Char
'Q']) =
      [Char] -> Map Partition (Map Partition (Spray Int))
forall a. HasCallStack => [Char] -> a
error [Char]
"transitionsHallLittlewoodToSchur: the character must be 'P' or 'Q'."
  | Bool
otherwise                     = 
      Char -> Int -> Map Partition (Map Partition (Spray Int))
forall a.
(Eq a, C a) =>
Char -> Int -> Map Partition (Map Partition (Spray a))
_transitionMatrixHallLittlewoodSchur Char
which Int
weight

-- | Skew Hall-Littlewood polynomial of a given skew partition. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in a single parameter

-- usually denoted by \(t\). When substituting \(t\) with \(0\) in the skew

-- Hall-Littlewood \(P\)-polynomials, one obtains the skew Schur polynomials.

skewHallLittlewoodPolynomial :: (Eq a, AlgRing.C a)
  => Int       -- ^ number of variables

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

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

  -> Char      -- ^ which skew Hall-Littlewood polynomial, @'P'@ or @'Q'@

  -> SimpleParametricSpray a
skewHallLittlewoodPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> Char -> SimpleParametricSpray a
skewHallLittlewoodPolynomial Int
n Partition
lambda Partition
mu Char
which 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewHallLittlewoodPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewHallLittlewoodPolynomial: invalid skew partition."
  | Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'P', Char
'Q']) =
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewHallLittlewoodPolynomial: the character must be 'P' or 'Q'."
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
      if Partition
lambda Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
mu then SimpleParametricSpray a
forall a. C a => Spray a
unitSpray else SimpleParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = 
      if Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'P' 
        then Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
forall a.
(Eq a, C a) =>
Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
skewHallLittlewoodP Int
n (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda) (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu)
        else Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
forall a.
(Eq a, C a) =>
Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
skewHallLittlewoodQ Int
n (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda) (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu)
  
-- | Skew Hall-Littlewood polynomial of a given skew partition. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in a single parameter

-- usually denoted by \(t\). When substituting \(t\) with \(0\) in the skew

-- Hall-Littlewood \(P\)-polynomials, one obtains the skew Schur polynomials.

skewHallLittlewoodPolynomial' :: 
     Int       -- ^ number of variables

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

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

  -> Char      -- ^ which skew Hall-Littlewood polynomial, @'P'@ or @'Q'@

  -> SimpleParametricQSpray
skewHallLittlewoodPolynomial' :: Int -> Partition -> Partition -> Char -> SimpleParametricQSpray
skewHallLittlewoodPolynomial' = Int -> Partition -> Partition -> Char -> SimpleParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> Char -> SimpleParametricSpray a
skewHallLittlewoodPolynomial

_tSkewSchurPolynomial ::
  (Eq a, AlgField.C a)
  => (Integer -> Integer -> a)
  -> Int
  -> Partition
  -> Partition
  -> SimpleParametricSpray a
_tSkewSchurPolynomial :: forall a.
(Eq a, C a) =>
(Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
_tSkewSchurPolynomial Integer -> Integer -> a
f Int
n Partition
lambda Partition
mu = [Spray (Spray a)] -> Spray (Spray a)
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray (Spray a)]
sprays
  where
    w :: Int
w = Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda Int -> Int -> Int
forall a. Num a => a -> a -> a
- Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu
    rhos :: [Partition]
rhos = Int -> [Partition]
partitions Int
w
    t :: Int -> Spray a
t = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1
    mapOfSprays :: IntMap (Spray a)
mapOfSprays = 
      [(Int, Spray a)] -> IntMap (Spray a)
forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList ((Int -> (Int, Spray a)) -> Partition -> [(Int, Spray a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
r -> (Int
r, Spray a
forall a. C a => Spray a
unitSpray Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Int -> Spray a
t Int
r)) [Int
1 .. Int
w])
    tPowerSumPol :: Partition -> Spray (Spray a)
tPowerSumPol Partition
rho = 
      (a -> Spray a) -> Spray a -> Spray (Spray a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map 
        ((a -> Spray a -> Spray a) -> Spray a -> a -> Spray a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Spray a -> Spray a
BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
(*^) ([Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ((Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (IntMap (Spray a) -> Int -> Spray a
forall a. IntMap a -> Int -> a
(IM.!) IntMap (Spray a)
mapOfSprays) Partition
rho))) 
          (Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
psPolynomial Int
n Partition
rho)
    lambda' :: Seq Int
lambda' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda
    mu' :: Seq Int
mu' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu
    chi_lambda_mu_rhos :: [(Partition, Int)]
chi_lambda_mu_rhos = 
      [(Partition
rho', Seq Int -> Seq Int -> Seq Int -> Int
chi_lambda_mu_rho Seq Int
lambda' Seq Int
mu' (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
rho')) 
        | Partition
rho <- [Partition]
rhos, let rho' :: Partition
rho' = Partition -> Partition
fromPartition Partition
rho]
    sprays :: [Spray (Spray a)]
sprays = 
      [
        (Integer -> Integer -> a
f (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
c) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Partition -> Int
zlambda Partition
rho)))
         a -> Spray (Spray a) -> Spray (Spray a)
forall a v. C a v => a -> v -> v
AlgMod.*> Partition -> Spray (Spray a)
tPowerSumPol Partition
rho
      | (Partition
rho, Int
c) <- [(Partition, Int)]
chi_lambda_mu_rhos, Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
      ]

-- | t-Schur polynomial. This is a multivariate symmetric polynomial whose 

-- coefficients are polynomial in a single parameter usually denoted by \(t\).

-- One obtains the Schur polynomials by substituting \(t\) with \(0\).  

-- The name \"\(t\)-Schur polynomial\" is taken from

-- [Wheeler and Zinn-Justin's paper](https://www.sciencedirect.com/science/article/pii/S0097316518300724)

-- /Hall polynomials, inverse Kostka polynomials and puzzles/.

tSchurPolynomial ::
  (Eq a, AlgField.C a)
  => Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> SimpleParametricSpray a
tSchurPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> SimpleParametricSpray a
tSchurPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"tSchurPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) =
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"tSchurPolynomial: invalid partition."
  | Bool
otherwise =
      (Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
forall a.
(Eq a, C a) =>
(Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
_tSkewSchurPolynomial 
        (\Integer
i Integer
j -> Integer -> a
forall a. C a => Integer -> a
AlgRing.fromInteger Integer
i a -> a -> a
forall a. C a => a -> a -> a
AlgField./ Integer -> a
forall a. C a => Integer -> a
AlgRing.fromInteger Integer
j)
          Int
n Partition
lambda []

-- | t-Schur polynomial. This is a multivariate symmetric polynomial whose 

-- coefficients are polynomial in a single parameter usually denoted by \(t\).

-- One obtains the Schur polynomials by substituting \(t\) with \(0\). 

-- The name \"\(t\)-Schur polynomial\" is taken from

-- [Wheeler and Zinn-Justin's paper](https://www.sciencedirect.com/science/article/pii/S0097316518300724)

-- /Hall polynomials, inverse Kostka polynomials and puzzles/.

tSchurPolynomial' ::
     Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> SimpleParametricQSpray
tSchurPolynomial' :: Int -> Partition -> SimpleParametricQSpray
tSchurPolynomial' Int
n Partition
lambda 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricQSpray
forall a. HasCallStack => [Char] -> a
error [Char]
"tSchurPolynomial': negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) =
      [Char] -> SimpleParametricQSpray
forall a. HasCallStack => [Char] -> a
error [Char]
"tSchurPolynomial': invalid partition."
  | Bool
otherwise =
      (Integer -> Integer -> Rational)
-> Int -> Partition -> Partition -> SimpleParametricQSpray
forall a.
(Eq a, C a) =>
(Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
_tSkewSchurPolynomial Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
(%) Int
n Partition
lambda []

-- | Skew t-Schur polynomial of a given skew partition. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in a single parameter

-- usually denoted by \(t\). One obtains the skew Schur polynomials by substituting 

-- \(t\) with \(0\). 

tSkewSchurPolynomial ::
  (Eq a, AlgField.C a)
  => Int       -- ^ number of variables

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

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

  -> SimpleParametricSpray a
tSkewSchurPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> SimpleParametricSpray a
tSkewSchurPolynomial Int
n Partition
lambda Partition
mu
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"tSkewSchurPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"tSkewSchurPolynomial: invalid skew partition."
  | Bool
otherwise =
      (Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
forall a.
(Eq a, C a) =>
(Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
_tSkewSchurPolynomial 
        (\Integer
i Integer
j -> Integer -> a
forall a. C a => Integer -> a
AlgRing.fromInteger Integer
i a -> a -> a
forall a. C a => a -> a -> a
AlgField./ Integer -> a
forall a. C a => Integer -> a
AlgRing.fromInteger Integer
j)
          Int
n Partition
lambda Partition
mu

-- | Skew t-Schur polynomial of a given skew partition. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in a single parameter

-- usually denoted by \(t\). One obtains the skew Schur polynomials by substituting 

-- \(t\) with \(0\). 

tSkewSchurPolynomial' ::
     Int       -- ^ number of variables

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

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

  -> SimpleParametricQSpray
tSkewSchurPolynomial' :: Int -> Partition -> Partition -> SimpleParametricQSpray
tSkewSchurPolynomial' = (Integer -> Integer -> Rational)
-> Int -> Partition -> Partition -> SimpleParametricQSpray
forall a.
(Eq a, C a) =>
(Integer -> Integer -> a)
-> Int -> Partition -> Partition -> SimpleParametricSpray a
_tSkewSchurPolynomial Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
(%)

-- | Macdonald polynomial. This is a symmetric multivariate polynomial 

-- depending on two parameters usually denoted by \(q\) and \(t\).

-- Substituting \(q\) with \(0\) yields the Hall-Littlewood polynomials.

--

-- >>> macPoly = macdonaldPolynomial 3 [2, 1] 'P'

-- >>> putStrLn $ prettySymmetricParametricQSpray ["q", "t"] macPoly

-- { [ 1 ] }*M[2,1] + { [ 2*q.t^2 - q.t - q + t^2 + t - 2 ] %//% [ q.t^2 - 1 ] }*M[1,1,1]

macdonaldPolynomial :: (Eq a, AlgField.C a) 
  => Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> Char       -- ^ which Macdonald polynomial, @'P'@ or @'Q'@

  -> ParametricSpray a
macdonaldPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> ParametricSpray a
macdonaldPolynomial Int
n Partition
lambda Char
which
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"macdonaldPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"macdonaldPolynomial: invalid partition."
  | Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'P', Char
'Q']) =
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"macdonaldPolynomial: last argument must be 'P' or 'Q'."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda = 
      ParametricSpray a
forall a. C a => Spray a
unitSpray
  | Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = 
      ParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = 
      if Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'P'
        then Int -> Partition -> ParametricSpray a
forall a. (Eq a, C a) => Int -> Partition -> ParametricSpray a
macdonaldPolynomialP Int
n Partition
lambda
        else Int -> Partition -> ParametricSpray a
forall a. (Eq a, C a) => Int -> Partition -> ParametricSpray a
macdonaldPolynomialQ Int
n Partition
lambda

-- | Macdonald polynomial. This is a symmetric multivariate polynomial 

-- depending on two parameters usually denoted by \(q\) and \(t\).

-- Substituting \(q\) with \(0\) yields the Hall-Littlewood polynomials.

macdonaldPolynomial' ::  
     Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> Char       -- ^ which Macdonald polynomial, @'P'@ or @'Q'@

  -> ParametricQSpray
macdonaldPolynomial' :: Int -> Partition -> Char -> ParametricQSpray
macdonaldPolynomial' = Int -> Partition -> Char -> ParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> ParametricSpray a
macdonaldPolynomial

-- | Skew Macdonald polynomial of a given skew partition. This is a multivariate 

-- symmetric polynomial with two parameters usually denoted by \(q\) and \(t\).

-- Substituting \(q\) with \(0\) yields the skew Hall-Littlewood polynomials.

skewMacdonaldPolynomial :: (Eq a, AlgField.C a)
  => Int       -- ^ number of variables

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

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

  -> Char      -- ^ which skew Macdonald polynomial, @'P'@ or @'Q'@

  -> ParametricSpray a
skewMacdonaldPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> Char -> ParametricSpray a
skewMacdonaldPolynomial Int
n Partition
lambda Partition
mu Char
which 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewMacdonaldPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) = 
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewMacdonaldPolynomial: invalid skew partition."
  | Bool -> Bool
not (Char
which Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'P', Char
'Q']) =
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewMacdonaldPolynomial: the character must be 'P' or 'Q'."
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
      if Partition
lambda Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
mu then ParametricSpray a
forall a. C a => Spray a
unitSpray else ParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = 
      if Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'P' 
        then Int -> Partition -> Partition -> ParametricSpray a
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldPolynomialP Int
n Partition
lambda Partition
mu
        else Int -> Partition -> Partition -> ParametricSpray a
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldPolynomialQ Int
n Partition
lambda Partition
mu

-- | Skew Macdonald polynomial of a given skew partition. This is a multivariate 

-- symmetric polynomial with two parameters usually denoted by \(q\) and \(t\).

-- Substituting \(q\) with \(0\) yields the skew Hall-Littlewood polynomials.

skewMacdonaldPolynomial' :: 
     Int       -- ^ number of variables

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

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

  -> Char      -- ^ which skew Macdonald polynomial, @'P'@ or @'Q'@

  -> ParametricQSpray
skewMacdonaldPolynomial' :: Int -> Partition -> Partition -> Char -> ParametricQSpray
skewMacdonaldPolynomial' = Int -> Partition -> Partition -> Char -> ParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> Char -> ParametricSpray a
skewMacdonaldPolynomial

-- | Macdonald J-polynomial. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in two parameters.

macdonaldJpolynomial :: 
  forall a. (Eq a, AlgField.C a)
  => Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> SimpleParametricSpray a
macdonaldJpolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> SimpleParametricSpray a
macdonaldJpolynomial Int
n Partition
lambda 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"macdonaldJpolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"macdonaldJpolynomial: invalid partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda = 
      SimpleParametricSpray a
forall a. C a => Spray a
unitSpray
  | Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = 
      SimpleParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise =
      ParametricSpray a -> SimpleParametricSpray a
forall a. ParametricSpray a -> SimpleParametricSpray a
asSimpleParametricSprayUnsafe (ParametricSpray a -> SimpleParametricSpray a)
-> ParametricSpray a -> SimpleParametricSpray a
forall a b. (a -> b) -> a -> b
$
        (RatioOfSprays a -> RatioOfSprays a)
-> ParametricSpray a -> ParametricSpray a
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (Spray a -> RatioOfSprays a -> RatioOfSprays a
forall a v. C a v => a -> v -> v
(AlgMod.*>) (Seq Int -> Spray a
forall a. (Eq a, C a) => Seq Int -> Spray a
clambda (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda) :: Spray a)) 
          (Int -> Partition -> Char -> ParametricSpray a
forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> ParametricSpray a
macdonaldPolynomial Int
n Partition
lambda Char
'P')

-- | Macdonald J-polynomial. This is a multivariate 

-- symmetric polynomial whose coefficients are polynomial in two parameters.

macdonaldJpolynomial' :: 
     Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> SimpleParametricQSpray
macdonaldJpolynomial' :: Int -> Partition -> SimpleParametricQSpray
macdonaldJpolynomial' = Int -> Partition -> SimpleParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> SimpleParametricSpray a
macdonaldJpolynomial

-- | Skew Macdonald J-polynomial. This is a multivariate 

-- symmetric polynomial whose coefficients depend on two parameters.

skewMacdonaldJpolynomial :: 
  (Eq a, AlgField.C a)
  => Int       -- ^ number of variables

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

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

  -> ParametricSpray a
skewMacdonaldJpolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldJpolynomial Int
n Partition
lambda Partition
mu 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewMacdonaldJpolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) = 
      [Char] -> ParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewMacdonaldJpolynomial: invalid skew partition."
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
      if Partition
lambda Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
mu then ParametricSpray a
forall a. C a => Spray a
unitSpray else ParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = 
      Seq Int -> Seq Int -> RatioOfSprays a
forall a. (Eq a, C a) => Seq Int -> Seq Int -> RatioOfSprays a
clambdamu (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda) (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu)  
        BaseRing (ParametricSpray a)
-> ParametricSpray a -> ParametricSpray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Int -> Partition -> Partition -> Char -> ParametricSpray a
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> Char -> ParametricSpray a
skewMacdonaldPolynomial Int
n Partition
lambda Partition
mu Char
'P'

-- | Skew Macdonald J-polynomial. This is a multivariate 

-- symmetric polynomial whose coefficients depend on two parameters.

skewMacdonaldJpolynomial' :: 
     Int       -- ^ number of variables

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

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

  -> ParametricQSpray
skewMacdonaldJpolynomial' :: Int -> Partition -> Partition -> ParametricQSpray
skewMacdonaldJpolynomial' = Int -> Partition -> Partition -> ParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldJpolynomial

macdonaldJinPSbasis ::
  (Eq a, AlgField.C a) => Partition -> Map Partition (Spray a)
macdonaldJinPSbasis :: forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
macdonaldJinPSbasis Partition
mu = 
  (Spray a -> Bool)
-> Map Partition (Spray a) -> Map Partition (Spray a)
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (Bool -> Bool
not (Bool -> Bool) -> (Spray a -> Bool) -> Spray a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spray a -> Bool
forall a. Spray a -> Bool
isZeroSpray) 
    ((Spray a -> Spray a -> Spray a)
-> [Map Partition (Spray a)] -> Map Partition (Spray a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
unionsWith Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
(^+^) (Map Partition (Map Partition (Spray a))
-> [Map Partition (Spray a)]
forall k a. Map k a -> [a]
DM.elems (Map Partition (Map Partition (Spray a))
 -> [Map Partition (Spray a)])
-> Map Partition (Map Partition (Spray a))
-> [Map Partition (Spray a)]
forall a b. (a -> b) -> a -> b
$ (Partition -> Spray a -> Map Partition (Spray a))
-> Map Partition (Spray a)
-> Map Partition (Map Partition (Spray a))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey Partition -> Spray a -> Map Partition (Spray a)
forall {b}.
(FunctionLike b, C (BaseRing b)) =>
Partition -> b -> Map Partition b
combo_to_map Map Partition (Spray a)
macdonaldCombo))
  where
    macdonaldCombo :: Map Partition (Spray a)
macdonaldCombo = Partition -> Map Partition (Spray a)
forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
macdonaldJinMSPbasis Partition
mu
    combo_to_map :: Partition -> b -> Map Partition b
combo_to_map Partition
lambda b
spray = 
      (Rational -> b) -> Map Partition Rational -> Map Partition b
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map 
        (\Rational
r -> Rational -> BaseRing b
forall a. C a => Rational -> a
fromRational Rational
r BaseRing b -> b -> b
forall b. FunctionLike b => BaseRing b -> b -> b
*^ b
spray) 
          (Partition -> Map Partition Rational
mspInPSbasis Partition
lambda)

-- | Modified Macdonald polynomial. This is a multivariate symmetric polynomial

-- whose coefficients are polynomials in two parameters.

modifiedMacdonaldPolynomial :: 
     (Eq a, AlgField.C a) 
  => Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> SimpleParametricSpray a
modifiedMacdonaldPolynomial :: forall a.
(Eq a, C a) =>
Int -> Partition -> SimpleParametricSpray a
modifiedMacdonaldPolynomial Int
n Partition
mu 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"modifiedMacdonaldPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
mu) = 
      [Char] -> SimpleParametricSpray a
forall a. HasCallStack => [Char] -> a
error [Char]
"modifiedMacdonaldPolynomial: invalid partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
mu = 
      SimpleParametricSpray a
forall a. C a => Spray a
unitSpray
  | Bool
otherwise = 
      SimpleParametricSpray a
jp 
  where
    psCombo :: Map Partition (Spray a)
psCombo = Partition -> Map Partition (Spray a)
forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
macdonaldJinPSbasis Partition
mu
    q' :: Int -> Spray a
q' = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1
    t' :: Int -> Spray a
t' = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
2
    num_and_den :: Seq Int -> (Spray a, Spray a)
num_and_den Seq Int
Empty = (Spray a, Spray a)
forall a. HasCallStack => a
undefined
    num_and_den (Int
e :<| Seq Int
Empty) = (Int -> Spray a
q' Int
e, Spray a
forall a. C a => Spray a
unitSpray)
    num_and_den (Int
e1 :<| (Int
e2 :<| Seq Int
_)) = (Int -> Spray a
q' Int
e1, Int -> Spray a
t' Int
e2)
    rOS_from_term :: Powers -> a -> RatioOfSprays a
rOS_from_term Powers
powers a
coeff = a
BaseRing (RatioOfSprays a)
coeff BaseRing (RatioOfSprays a) -> RatioOfSprays a -> RatioOfSprays a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a -> Spray a -> RatioOfSprays a
forall a. Spray a -> Spray a -> RatioOfSprays a
RatioOfSprays Spray a
spray1 Spray a
spray2
      where
        (Spray a
spray1, Spray a
spray2) = Seq Int -> (Spray a, Spray a)
num_and_den (Powers -> Seq Int
exponents Powers
powers)
    toROS :: Spray a -> RatioOfSprays a
toROS Spray a
spray = 
      (RatioOfSprays a -> Powers -> a -> RatioOfSprays a)
-> RatioOfSprays a -> Spray a -> RatioOfSprays a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' 
        (\RatioOfSprays a
ros Powers
powers a
coeff -> RatioOfSprays a
ros RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
AlgAdd.+ Powers -> a -> RatioOfSprays a
rOS_from_term Powers
powers a
coeff) 
          RatioOfSprays a
forall a. (C a, Eq a) => RatioOfSprays a
zeroRatioOfSprays Spray a
spray
    den :: Partition -> Spray a
den Partition
lambda = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Int -> Spray a
t' Int
k Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Spray a
forall a. C a => Spray a
unitSpray | Int
k <- Partition
lambda]
    nmu :: Int
nmu = Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Int -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) [Int
1 .. ] (Int -> Partition -> Partition
forall a. Int -> [a] -> [a]
drop Int
1 Partition
mu))
    jp :: SimpleParametricSpray a
jp = (SimpleParametricSpray a
 -> Partition -> Spray a -> SimpleParametricSpray a)
-> SimpleParametricSpray a
-> Map Partition (Spray a)
-> SimpleParametricSpray a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
DM.foldlWithKey 
      (\SimpleParametricSpray a
spray Partition
lambda Spray a
c -> 
          SimpleParametricSpray a
spray SimpleParametricSpray a
-> SimpleParametricSpray a -> SimpleParametricSpray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ 
            RatioOfSprays a -> Spray a
forall a. RatioOfSprays a -> Spray a
_numerator (Spray a -> RatioOfSprays a
toROS (Int -> Spray a
t' (Int
nmu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda) Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
c) RatioOfSprays a -> Spray a -> RatioOfSprays a
forall a.
(Eq a, C a) =>
RatioOfSprays a -> Spray a -> RatioOfSprays a
%/% Partition -> Spray a
den Partition
lambda) 
              BaseRing (SimpleParametricSpray a)
-> SimpleParametricSpray a -> SimpleParametricSpray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Int -> Partition -> SimpleParametricSpray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
psPolynomial Int
n Partition
lambda)
      SimpleParametricSpray a
forall a. (Eq a, C a) => Spray a
zeroSpray Map Partition (Spray a)
psCombo

-- | Modified Macdonald polynomial. This is a multivariate symmetric polynomial

-- whose coefficients are polynomials in two parameters.

modifiedMacdonaldPolynomial' :: 
     Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> SimpleParametricQSpray 
modifiedMacdonaldPolynomial' :: Int -> Partition -> SimpleParametricQSpray
modifiedMacdonaldPolynomial' = Int -> Partition -> SimpleParametricQSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> SimpleParametricSpray a
modifiedMacdonaldPolynomial

-- | Flagged Schur polynomial. A flagged Schur polynomial is not symmetric 

-- in general.

flaggedSchurPol :: 
  (Eq a, AlgRing.C a) 
  => Partition -- ^ integer partition

  -> [Int]     -- ^ lower bounds

  -> [Int]     -- ^ upper bounds

  -> Spray a
flaggedSchurPol :: forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Spray a
flaggedSchurPol Partition
lambda Partition
as Partition
bs
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) =
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSchurPol: invalid partition."
  | Bool -> Bool
not (Partition -> Bool
forall a. Eq a => [a] -> Bool
allSame [Int
llambda, Int
las, Int
lbs]) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSchurPol: the partition and the lists of lower bounds and upper bounds must have the same length."
  | Int
llambda Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      Spray a
forall a. C a => Spray a
unitSpray
  | Bool -> Bool
not (Partition -> Bool
isIncreasing Partition
as) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSchurPol: the list of lower bounds is not increasing."
  | Bool -> Bool
not (Partition -> Bool
isIncreasing Partition
bs) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSchurPol: the list of upper bounds is not increasing."
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Int -> Int -> Bool) -> Partition -> Partition -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>) Partition
as Partition
bs) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSchurPol: lower bounds must be smaller than upper bounds."
  | Bool
otherwise = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
sprays
    where
      llambda :: Int
llambda = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
      las :: Int
las = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
as
      lbs :: Int
lbs = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
bs
      tableaux :: [[Partition]]
tableaux = Partition -> Partition -> Partition -> [[Partition]]
flaggedSemiStandardYoungTableaux Partition
lambda Partition
as Partition
bs
      monomial :: [Partition] -> Spray a
monomial [Partition]
tableau = 
        [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ([Spray a] -> Spray a) -> [Spray a] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' [Int
1 ..] ([Partition] -> Partition
tableauWeight [Partition]
tableau)
      sprays :: [Spray a]
sprays = ([Partition] -> Spray a) -> [[Partition]] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map [Partition] -> Spray a
forall {a}. (Eq a, C a) => [Partition] -> Spray a
monomial [[Partition]]
tableaux

-- | Flagged Schur polynomial. A flagged Schur polynomial is not symmetric 

-- in general.

flaggedSchurPol' :: 
     Partition -- ^ integer partition

  -> [Int]     -- ^ lower bounds

  -> [Int]     -- ^ upper bounds

  -> QSpray
flaggedSchurPol' :: Partition -> Partition -> Partition -> QSpray
flaggedSchurPol' = Partition -> Partition -> Partition -> QSpray
forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Spray a
flaggedSchurPol

-- | Flagged skew Schur polynomial. A flagged skew Schur polynomial is not symmetric 

-- in general.

flaggedSkewSchurPol :: 
  (Eq a, AlgRing.C a) 
  => Partition -- ^ outer partition of the skew partition

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

  -> [Int]     -- ^ lower bounds

  -> [Int]     -- ^ upper bounds

  -> Spray a
flaggedSkewSchurPol :: forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Partition -> Spray a
flaggedSkewSchurPol Partition
lambda Partition
mu Partition
as Partition
bs
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSkewSchurPol: invalid skew partition."
  | Bool -> Bool
not (Partition -> Bool
forall a. Eq a => [a] -> Bool
allSame [Int
llambda, Int
las, Int
lbs]) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSkewSchurPol: the outer partition and the lists of lower bounds and upper bounds must have the same length."
  | Bool -> Bool
not (Partition -> Bool
isIncreasing Partition
as) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSkewSchurPol: the list of lower bounds is not increasing."
  | Bool -> Bool
not (Partition -> Bool
isIncreasing Partition
bs) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSkewSchurPol: the list of upper bounds is not increasing."
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Int -> Int -> Bool) -> Partition -> Partition -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>) Partition
as Partition
bs) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"flaggedSkewSchurPol: lower bounds must be smaller than upper bounds."
  | Partition
lambda Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
mu =
      Spray a
forall a. C a => Spray a
unitSpray
  | Bool
otherwise = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
sprays
    where
      llambda :: Int
llambda = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
      las :: Int
las = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
as
      lbs :: Int
lbs = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
bs
      tableaux :: [[(Int, Partition)]]
tableaux = Partition
-> Partition -> Partition -> Partition -> [[(Int, Partition)]]
flaggedSkewTableaux Partition
lambda Partition
mu Partition
as Partition
bs
      monomial :: [(Int, Partition)] -> Spray a
monomial [(Int, Partition)]
tableau = 
        [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ([Spray a] -> Spray a) -> [Spray a] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' [Int
1 ..] ([(Int, Partition)] -> Partition
skewTableauWeight [(Int, Partition)]
tableau)
      sprays :: [Spray a]
sprays = ([(Int, Partition)] -> Spray a)
-> [[(Int, Partition)]] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, Partition)] -> Spray a
forall {a}. (Eq a, C a) => [(Int, Partition)] -> Spray a
monomial [[(Int, Partition)]]
tableaux

-- | Flagged skew Schur polynomial. A flagged skew Schur polynomial is not symmetric 

-- in general.

flaggedSkewSchurPol' :: 
     Partition -- ^ outer partition of the skew partition

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

  -> [Int]     -- ^ lower bounds

  -> [Int]     -- ^ upper bounds

  -> QSpray
flaggedSkewSchurPol' :: Partition -> Partition -> Partition -> Partition -> QSpray
flaggedSkewSchurPol' = Partition -> Partition -> Partition -> Partition -> QSpray
forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Partition -> Spray a
flaggedSkewSchurPol

-- | Factorial Schur polynomial. See

-- [Kreiman's paper](https://www.combinatorics.org/ojs/index.php/eljc/article/view/v15i1r84/pdf)

-- /Products of factorial Schur functions/ for the definition.

factorialSchurPol :: 
  (Eq a, AlgRing.C a)
  => Int       -- ^ number of variables

  -> Partition -- ^ integer partition

  -> [a]       -- ^ the sequence denoted by \(y\) in the reference paper 

  -> Spray a
factorialSchurPol :: forall a. (Eq a, C a) => Int -> Partition -> [a] -> Spray a
factorialSchurPol Int
n Partition
lambda [a]
y 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"factorialSchurPol: negative number of variables." 
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) =
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"factorialSchurPol: invalid integer partition."
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
      if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Spray a
forall a. C a => Spray a
unitSpray else Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = 
      [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
sprays
  where
    l :: Int
l = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
    tableaux :: [[Partition]]
tableaux = Int -> Partition -> [[Partition]]
semiStandardYoungTableaux Int
n (Partition -> Partition
toPartition Partition
lambda)
    lones :: [Spray a]
lones = [Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
i | Int
i <- [Int
1 .. Int
n]]
    idx :: [Partition] -> Int -> Int -> (Int, Int)
idx [Partition]
tableau Int
i Int
j = 
      let row :: Partition
row = [Partition]
tableau [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) 
          a :: Int
a = Partition
row Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      in (Int
a, Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) 
    factor :: [Partition] -> Int -> Int -> Spray a
factor [Partition]
tableau Int
i Int
j = 
      let (Int
a, Int
k) = [Partition] -> Int -> Int -> (Int, Int)
idx [Partition]
tableau Int
i Int
j in [Spray a]
lones [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ [a]
y [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    i_ :: Partition
i_ = [Int
1 .. Int
l]
    ij_ :: [(Int, Int)]
ij_ = [(Int
i, Int
j) | Int
i <- Partition
i_, Int
j <- [Int
1 .. Partition
lambda Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]
    factors :: [Partition] -> [Spray a]
factors [Partition]
tableau = [[Partition] -> Int -> Int -> Spray a
factor [Partition]
tableau Int
i Int
j | (Int
i, Int
j) <- [(Int, Int)]
ij_]
    spray :: [Partition] -> Spray a
spray [Partition]
tableau = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ([Partition] -> [Spray a]
factors [Partition]
tableau)
    sprays :: [Spray a]
sprays = ([Partition] -> Spray a) -> [[Partition]] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map [Partition] -> Spray a
spray [[Partition]]
tableaux

-- | Factorial Schur polynomial. See

-- [Kreiman's paper](https://www.combinatorics.org/ojs/index.php/eljc/article/view/v15i1r84/pdf)

-- /Products of factorial Schur functions/ for the definition.

factorialSchurPol' :: 
     Int        -- ^ number of variables

  -> Partition  -- ^ integer partition

  -> [Rational] -- ^ the sequence denoted by \(y\) in the reference paper

  -> QSpray
factorialSchurPol' :: Int -> Partition -> [Rational] -> QSpray
factorialSchurPol' = Int -> Partition -> [Rational] -> QSpray
forall a. (Eq a, C a) => Int -> Partition -> [a] -> Spray a
factorialSchurPol

-- | Skew factorial Schur polynomial. See 

-- [Macdonald's paper](https://www.kurims.kyoto-u.ac.jp/EMIS/journals/SLC/opapers/s28macdonald.pdf)

-- /Schur functions: theme and variations/, 6th variation, for the definition.

skewFactorialSchurPol :: 
  (Eq a, AlgRing.C a)
  => Int       -- ^ number of variables

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

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

  -> IntMap a  -- ^ the sequence denoted by \(a\) in the reference paper

  -> Spray a
skewFactorialSchurPol :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> IntMap a -> Spray a
skewFactorialSchurPol Int
n Partition
lambda Partition
mu IntMap a
y 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewFactorialSchurPol: negative number of variables." 
  | Bool -> Bool
not (Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu) =
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"skewFactorialSchurPol: invalid skew integer partition."
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
      if Partition
lambda Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
mu then Spray a
forall a. C a => Spray a
unitSpray else Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise = 
      [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
sprays
  where
    skewPartition :: SkewPartition
skewPartition = (Partition, Partition) -> SkewPartition
mkSkewPartition (Partition -> Partition
toPartition Partition
lambda, Partition -> Partition
toPartition Partition
mu)
    skewTableaux :: [SkewTableau Int]
skewTableaux = Int -> SkewPartition -> [SkewTableau Int]
semiStandardSkewTableaux Int
n SkewPartition
skewPartition
    getSkewTableau :: SkewTableau a -> [(Int, [a])]
getSkewTableau (SkewTableau [(Int, [a])]
x) = [(Int, [a])]
x
    lones :: [Spray a]
lones = [Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
i | Int
i <- [Int
1 .. Int
n]]
    idx :: [(Int, Partition)] -> Int -> Int -> (Int, Int)
idx [(Int, Partition)]
tableau Int
i Int
j = 
      let (Int
offset, Partition
entries) = [(Int, Partition)]
tableau [(Int, Partition)] -> Int -> (Int, Partition)
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) 
          a :: Int
a = Partition
entries Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      in (Int
a, Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) 
    factor :: [(Int, Partition)] -> Int -> Int -> Spray a
factor [(Int, Partition)]
tableau Int
i Int
j = 
      let (Int
a, Int
k) = [(Int, Partition)] -> Int -> Int -> (Int, Int)
idx [(Int, Partition)]
tableau Int
i Int
j in [Spray a]
lones [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ IntMap a
y IntMap a -> Int -> a
forall a. IntMap a -> Int -> a
IM.! Int
k
    i_ :: Partition
i_ = [Int
1 .. Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda]
    ij_ :: [(a, t a)] -> [(Int, Int)]
ij_ [(a, t a)]
tableau = 
      [(Int
i, Int
j) | Int
i <- Partition
i_, Int
j <- [Int
1 .. t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a, t a) -> t a
forall a b. (a, b) -> b
snd ([(a, t a)]
tableau [(a, t a)] -> Int -> (a, t a)
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)))]]
    factors :: [(Int, Partition)] -> [Spray a]
factors [(Int, Partition)]
tableau = [[(Int, Partition)] -> Int -> Int -> Spray a
factor [(Int, Partition)]
tableau Int
i Int
j | (Int
i, Int
j) <- [(Int, Partition)] -> [(Int, Int)]
forall {t :: * -> *} {a} {a}.
Foldable t =>
[(a, t a)] -> [(Int, Int)]
ij_ [(Int, Partition)]
tableau]
    spray :: SkewTableau Int -> Spray a
spray SkewTableau Int
tableau = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ([(Int, Partition)] -> [Spray a]
factors (SkewTableau Int -> [(Int, Partition)]
forall {a}. SkewTableau a -> [(Int, [a])]
getSkewTableau SkewTableau Int
tableau))
    sprays :: [Spray a]
sprays = (SkewTableau Int -> Spray a) -> [SkewTableau Int] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map SkewTableau Int -> Spray a
spray [SkewTableau Int]
skewTableaux

-- | Skew factorial Schur polynomial. See 

-- [Macdonald's paper](https://www.kurims.kyoto-u.ac.jp/EMIS/journals/SLC/opapers/s28macdonald.pdf)

-- /Schur functions: theme and variations/, 6th variation, for the definition.

skewFactorialSchurPol' :: 
     Int             -- ^ number of variables

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

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

  -> IntMap Rational -- ^ the sequence denoted by \(a\) in the reference paper

  -> QSpray
skewFactorialSchurPol' :: Int -> Partition -> Partition -> IntMap Rational -> QSpray
skewFactorialSchurPol' = Int -> Partition -> Partition -> IntMap Rational -> QSpray
forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> IntMap a -> Spray a
skewFactorialSchurPol