{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Math.Algebra.Jack.Internal
  ( Partition
  , msPolynomialUnsafe
  , _esPolynomial
  , jackJpol0
  , jackCoeffP
  , jackCoeffQ
  , jackCoeffC
  , jackSymbolicCoeffC
  , jackSymbolicCoeffPinv
  , jackSymbolicCoeffQinv
  , _betaratio
  , _betaRatioOfSprays
  , _isPartition
  , _N
  , _fromInt
  , skewSchurLRCoefficients
  , isSkewPartition
  , sprayToMap
  , comboToSpray
  , _kostkaNumbersWithGivenLambda
  , _kostkaNumbers
  , _inverseKostkaMatrix
  , _symbolicKostkaNumbersWithGivenLambda
  , _symbolicKostkaNumbers
  , _inverseSymbolicKostkaMatrix
  , _kostkaFoulkesPolynomial
  , _hallLittlewoodPolynomialsInSchurBasis
  , _transitionMatrixHallLittlewoodSchur
  , skewHallLittlewoodP
  , skewHallLittlewoodQ
  , flaggedSemiStandardYoungTableaux
  , tableauWeight
  , isIncreasing
  , flaggedSkewTableaux
  , skewTableauWeight
  , _skewKostkaFoulkesPolynomial
  , macdonaldPolynomialP
  , macdonaldPolynomialQ
  , skewMacdonaldPolynomialP
  , skewMacdonaldPolynomialQ
  , chi_lambda_mu_rho
  , clambda
  , clambdamu
  , macdonaldJinMSPbasis
  , inverseKostkaNumbers
  , skewSymbolicJackInMSPbasis 
  , skewJackInMSPbasis
  , _skewGelfandTsetlinPatterns
  , _skewTableauxWithGivenShapeAndWeight
  , _semiStandardTableauxWithGivenShapeAndWeight
  , _msPolynomialInHLPbasis
  )
  where
import           Prelude 
  hiding ((*), (+), (-), (/), (^), (*>), product, sum, fromIntegral, fromInteger, recip)
import qualified Prelude                                     as P  
import           Algebra.Additive                            ( (+), (-), sum )
import qualified Algebra.Additive                            as AlgAdd
import           Algebra.Field                               ( (/), recip )
import qualified Algebra.Field                               as AlgField
import           Algebra.Module                              ( (*>) )
import           Algebra.Ring                                ( (*), product, one
                                                             , (^), fromInteger 
                                                             )
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.List                                   ( 
                                                               nub
                                                             , foldl'
                                                             , uncons
                                                             , tails
                                                             )
import           Data.List.Extra                             ( 
                                                               drop1
                                                             )
import           Data.List.Index                             ( iconcatMap )
import           Data.Map.Strict                             ( Map )
import qualified Data.Map.Strict                             as DM
import           Data.Matrix                                 ( 
                                                               Matrix
                                                             , nrows
                                                             , getCol 
                                                             , getRow
                                                             , minorMatrix
                                                             , (<|>)
                                                             , (<->)
                                                             , rowVector
                                                             , colVector
                                                             , getElem
                                                             , fromLists
                                                             )
import           Data.Maybe                                  ( fromJust, isJust )
import           Data.Sequence                               ( 
                                                               Seq (..)
                                                             , (|>) 
                                                             , (<|)
                                                             , (><)
                                                             )
import qualified Data.Sequence                               as S
import qualified Data.Set                                    as DS
import           Data.Tuple.Extra                            ( fst3, both, swap )
import qualified Data.Vector                                 as V
import           Math.Algebra.Hspray                         ( 
                                                               RatioOfSprays (..), (%:%), (%//%), (%/%)
                                                             , unitRatioOfSprays
                                                             , zeroRatioOfSprays
                                                             , asRatioOfSprays
                                                             , Spray, (.^)
                                                             , Powers (..)
                                                             , SimpleParametricSpray
                                                             , ParametricSpray
                                                             , zeroSpray
                                                             , unitSpray
                                                             , isZeroSpray
                                                             , lone, lone'
                                                             , sumOfSprays
                                                             , productOfSprays
                                                             , FunctionLike (..)
                                                             , fromList
                                                             )
import           Math.Combinat.Partitions.Integer            (
                                                               fromPartition
                                                             , dualPartition
                                                             , partitions
                                                             , partitions'
                                                             , dominatedPartitions
                                                             , partitionWidth
                                                             , toPartitionUnsafe
                                                             , dropTailingZeros
                                                             )
import qualified Math.Combinat.Partitions.Integer            as MCP
import           Math.Combinat.Permutations                  ( permuteMultiset )
import           Math.Combinat.Tableaux.GelfandTsetlin       (
                                                                GT
                                                              , kostkaGelfandTsetlinPatterns
                                                              , kostkaGelfandTsetlinPatterns'
                                                              , kostkaNumbersWithGivenLambda
                                                             )
import           Math.Combinat.Tableaux.LittlewoodRichardson ( _lrRule )


type Partition = [Int]

type PartitionsPair = (Seq Int, Seq Int)
type PairsMap = Map PartitionsPair ([(Int,Int)], [(Int,Int)]) 

-- | monomial symmetric polynomial

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

  -> Partition -- ^ integer partition

  -> Spray a
msPolynomialUnsafe :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomialUnsafe Int
n Partition
lambda
  = [(Partition, a)] -> Spray a
forall a. (C a, Eq a) => [(Partition, a)] -> Spray a
fromList ([(Partition, a)] -> Spray a) -> [(Partition, a)] -> Spray a
forall a b. (a -> b) -> a -> b
$ [Partition] -> [a] -> [(Partition, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
permutations [a]
coefficients
    where
      ellLambda :: Int
ellLambda    = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
      permutations :: [Partition]
permutations = Partition -> [Partition]
forall a. (Eq a, Ord a) => [a] -> [[a]]
permuteMultiset (Partition
lambda Partition -> Partition -> Partition
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
ellLambda) Int
0)
      coefficients :: [a]
coefficients = a -> [a]
forall a. a -> [a]
repeat a
forall a. C a => a
AlgRing.one

-- | elementary symmetric polynomial.

_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 =
  [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
esPolynomialK Partition
lambda)
    where
      esPolynomialK :: Int -> Spray a
esPolynomialK Int
k = Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomialUnsafe Int
n (Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate Int
k Int
1)

-- | Jack polynomial for alpha=0.

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

  -> Partition -- ^ integer partition

  -> Spray a
jackJpol0 :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
jackJpol0 Int
n Partition
lambda =
  Int
f Int -> Spray a -> Spray a
forall a. (C a, Eq a) => Int -> a -> a
.^ Int -> Partition -> Spray a
forall a. (C a, Eq a) => Int -> Partition -> Spray a
_esPolynomial Int
n (Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList Seq Int
lambda')
  where
    lambda' :: Seq Int
lambda' = Seq Int -> Seq Int
_dualPartition' (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda)
    factorial :: a -> a
factorial a
i = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
P.product [a
2 .. a
i]
    f :: Int
f = Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.product ((Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall {a}. (Num a, Enum a) => a -> a
factorial Seq Int
lambda')

inverseKostkaNumbers :: Int -> Map Partition (Map Partition Int)
inverseKostkaNumbers :: Int -> Map Partition (Map Partition Int)
inverseKostkaNumbers Int
n = 
  [(Partition, Map Partition Int)]
-> Map Partition (Map Partition Int)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition]
-> [Map Partition Int] -> [(Partition, Map Partition Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas' ((Int -> Map Partition Int) -> Partition -> [Map Partition Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Map Partition Int
maps [Int
1 .. [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
lambdas]))
  where
    lambdas :: [Partition]
lambdas = [Partition] -> [Partition]
forall a. [a] -> [a]
reverse (Int -> [Partition]
partitions Int
n)
    row :: Partition -> [b]
row Partition
lambda = 
      (Partition -> b) -> [Partition] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map 
        (\Partition
mu -> b -> Partition -> Map Partition b -> b
forall k a. Ord k => a -> k -> Map k a -> a
DM.findWithDefault b
0 Partition
mu (Partition -> Map Partition b
forall coeff. Num coeff => Partition -> Map Partition coeff
kostkaNumbersWithGivenLambda Partition
lambda)) 
          [Partition]
lambdas
    matrix :: Matrix Int
matrix = Matrix Int -> Matrix Int
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseUnitTriangularMatrix ([Partition] -> Matrix Int
forall a. [[a]] -> Matrix a
fromLists ((Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
forall {b}. Num b => Partition -> [b]
row [Partition]
lambdas))
    lambdas' :: [Partition]
lambdas' = (Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
fromPartition [Partition]
lambdas
    maps :: Int -> Map Partition Int
maps Int
i = [(Partition, Int)] -> Map Partition Int
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition] -> Partition -> [(Partition, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas' (Vector Int -> Partition
forall a. Vector a -> [a]
V.toList (Int -> Matrix Int -> Vector Int
forall a. Int -> Matrix a -> Vector a
getCol Int
i Matrix Int
matrix)))  

sequencesOfRibbons :: Seq Int -> Seq Int -> Seq Int -> [Seq (Seq Int)]
sequencesOfRibbons :: Seq Int -> Seq Int -> Seq Int -> [Seq (Seq Int)]
sequencesOfRibbons Seq Int
lambda Seq Int
mu Seq Int
rho = 
   (Int -> [Seq (Seq Int)] -> [Seq (Seq Int)])
-> [Seq (Seq Int)] -> Seq Int -> [Seq (Seq Int)]
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
     (\Int
r [Seq (Seq Int)]
zs -> 
      [Seq (Seq Int)
z Seq (Seq Int) -> Seq Int -> Seq (Seq Int)
forall a. Seq a -> a -> Seq a
|> Seq Int
lbda 
        | Seq (Seq Int)
z <- [Seq (Seq Int)]
zs
        , Seq Int
lbda <- Int -> Seq Int -> [Seq Int]
lambdas Int
r (Seq (Seq Int)
z Seq (Seq Int) -> Int -> Seq Int
forall a. Seq a -> Int -> a
`S.index` (Seq (Seq Int) -> Int
forall a. Seq a -> Int
S.length Seq (Seq Int)
z Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1))
        , Seq Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> Seq Int -> Seq Int -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Seq Int
lbda Seq Int
lambda)
      ]) 
        [Seq Int -> Seq (Seq Int)
forall a. a -> Seq a
S.singleton (Seq Int
mu Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< (Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu) Int
0))] 
          Seq Int
rho
   where
    n :: Int
n = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda 
    lambdas :: Int -> Seq Int -> [Seq Int]
lambdas Int
r Seq Int
nu = [Int -> Int -> Int -> Seq Int -> Seq Int
flambda Int
p Int
q Int
r Seq Int
nu | (Int
p, Int
q) <- Int -> Seq Int -> [(Int, Int)]
forall {a}. Num a => Int -> Seq Int -> [(a, Int)]
pairs Int
r Seq Int
nu [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> Seq Int -> [(Int, Int)]
pairs' Int
r Seq Int
nu]
    flambda :: Int -> Int -> Int -> Seq Int -> Seq Int
flambda Int
p Int
q Int
r Seq Int
nu = 
      (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.take (Int
pInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Seq Int
nu Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> 
        Seq Int
nu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
qInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
p Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
q Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
r) Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
><
          (Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.take (Int
qInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
p) (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop (Int
pInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Seq Int
nu)) Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
><
            Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
q Seq Int
nu
    pairs :: Int -> Seq Int -> [(a, Int)]
pairs Int
r Seq Int
nu = [(a
1, Int
q) | Int
q <- [Int
1 .. Int
n], Int -> Int -> Seq Int -> Bool
ok Int
q Int
r Seq Int
nu]
    ok :: Int -> Int -> Seq Int -> Bool
ok Int
q Int
r Seq Int
nu = 
      let nu_qm1 :: Int
nu_qm1 = Seq Int
nu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
qInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) in
        Int
nu_qm1 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
q Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq Int
nu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1 
          Bool -> Bool -> Bool
&& Int
nu_qm1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0
    pairs' :: Int -> Seq Int -> [(Int, Int)]
pairs' Int
r Seq Int
nu = 
      [(Int
p, Int
q) | Int
p <- [Int
2 .. Int
n], Int
q <- [Int
p .. Int
n], Int -> Int -> Int -> Seq Int -> Bool
ok' Int
p Int
q Int
r Seq Int
nu]
    ok' :: Int -> Int -> Int -> Seq Int -> Bool
ok' Int
p Int
q Int
r Seq Int
nu = 
       let nu_qm1 :: Int
nu_qm1 = Seq Int
nu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
qInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) in 
        Int
nu_qm1 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
q Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq Int
nu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
pInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
p 
          Bool -> Bool -> Bool
&& Seq Int
nu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
pInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
2) Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nu_qm1 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
q Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
r
          Bool -> Bool -> Bool
&& Int
nu_qm1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
pInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
          Bool -> Bool -> Bool
&& ((Int, Int) -> Bool) -> Seq (Int, Int) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool) -> (Int, Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)) 
                  (Seq Int -> Seq Int -> Seq (Int, Int)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.take (Int
qInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
p) (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop (Int
pInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Seq Int
nu)) (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
p Seq Int
lambda))

chi_lambda_mu_rho :: Seq Int -> Seq Int -> Seq Int -> Int
chi_lambda_mu_rho :: Seq Int -> Seq Int -> Seq Int -> Int
chi_lambda_mu_rho Seq Int
lambda Seq Int
mu Seq Int
rho = 
  if Seq Int -> Bool
forall a. Seq a -> Bool
S.null Seq Int
rho then Int
1 else Int
2 Int -> Int -> Int
forall a. C a => a -> a -> a
* Int
nevens Int -> Int -> Int
forall a. C a => a -> a -> a
- [Seq (Seq Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Seq (Seq Int)]
sequences
  where
    ribbonHeight :: Seq Int -> Seq Int -> Int
    ribbonHeight :: Seq Int -> Seq Int -> Int
ribbonHeight Seq Int
kappa Seq Int
nu = 
      Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum 
        ((Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (\Int
k Int
n -> Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n)) Seq Int
kappa Seq Int
nu) 
          Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1
      -- kappa and mu have same length so don't need to add S.length kappa - S.length mu 

    sequences :: [Seq (Seq Int)]
sequences = Seq Int -> Seq Int -> Seq Int -> [Seq (Seq Int)]
sequencesOfRibbons Seq Int
lambda Seq Int
mu Seq Int
rho 
    nevens :: Int
nevens =
      Partition -> Int
forall a. C a => [a] -> a
sum (Partition -> Int) -> Partition -> Int
forall a b. (a -> b) -> a -> b
$ (Seq (Seq Int) -> Int) -> [Seq (Seq Int)] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map 
        (
          \Seq (Seq Int)
sq -> 
            (Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> Int) -> (Seq Int -> Bool) -> Seq Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> (Seq Int -> Int) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum) (Seq Int -> Int) -> Seq Int -> Int
forall a b. (a -> b) -> a -> b
$
              (Seq Int -> Seq Int -> Int)
-> Seq (Seq Int) -> Seq (Seq Int) -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Seq Int -> Seq Int -> Int
ribbonHeight (Int -> Seq (Seq Int) -> Seq (Seq Int)
forall a. Int -> Seq a -> Seq a
S.drop Int
1 Seq (Seq Int)
sq) Seq (Seq Int)
sq
        )
          [Seq (Seq Int)]
sequences

gtPatternDiagonals' :: GT -> [Seq Int]
gtPatternDiagonals' :: [Partition] -> [Seq Int]
gtPatternDiagonals' [Partition]
pattern = Seq Int
forall a. Seq a
S.empty Seq Int -> [Seq Int] -> [Seq Int]
forall a. a -> [a] -> [a]
: [Int -> Seq Int
diagonal Int
j | Int
j <- [Int
0 .. Int
l]]
  where
    dropTrailingZeros :: Seq Int -> Seq Int
dropTrailingZeros = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.dropWhileR (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    l :: Int
l = [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
pattern Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1
    diagonal :: Int -> Seq Int
diagonal Int
j = 
      Seq Int -> Seq Int
dropTrailingZeros
        (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList
          [[Partition]
pattern [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! Int
r Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
c | (Int
r, Int
c) <- Partition -> Partition -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
j .. Int
l] [Int
0 .. Int
j]])

-- clambda :: (Eq a, AlgRing.C a) => Seq Int -> Spray a

-- clambda lambda = 

--   productOfSprays [unitSpray ^-^ q (a s) ^*^ t (l s + 1) | s <- pairs]

--   where

--     q = lone' 1

--     t = lone' 2

--     pairs = 

--       [(i, j) | i <- [1 .. S.length lambda], j <- [1 .. lambda `S.index` (i-1)]]

--     lambda' = _dualPartition' lambda

--     a (i, j) = lambda `S.index` (i-1) - j

--     l (i, j) = lambda' `S.index` (j-1) - i


alMapFromPairs :: Seq (Int, Int) -> Map (Int, Int) Int
alMapFromPairs :: Seq (Int, Int) -> Map (Int, Int) Int
alMapFromPairs Seq (Int, Int)
als = 
  (Map (Int, Int) Int -> (Int, Int) -> Map (Int, Int) Int)
-> Map (Int, Int) Int -> Seq (Int, Int) -> Map (Int, Int) Int
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map (Int, Int) Int
i (Int, Int)
al -> (Int -> Int -> Int)
-> (Int, Int) -> Int -> Map (Int, Int) Int -> Map (Int, Int) Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
DM.insertWith Int -> Int -> Int
forall a. C a => a -> a -> a
(+) (Int, Int)
al Int
1 Map (Int, Int) Int
i) Map (Int, Int) Int
forall k a. Map k a
DM.empty Seq (Int, Int)
als

alMap :: Seq Int -> Map (Int, Int) Int
alMap :: Seq Int -> Map (Int, Int) Int
alMap Seq Int
lambda = Seq (Int, Int) -> Map (Int, Int) Int
alMapFromPairs Seq (Int, Int)
als
  where
    lambda' :: Seq Int
lambda' = Seq Int -> Seq Int
_dualPartition' Seq Int
lambda
    zs :: Seq (Int, Int)
zs = Seq Int -> Seq Int -> Seq (Int, Int)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq Int
lambda (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList [Int
1 .. Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda])
    zs' :: Seq (Int, Int)
zs' = Seq Int -> Seq Int -> Seq (Int, Int)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq Int
lambda' (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList [Int
1 .. Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda'])
    als :: Seq (Int, Int)
als = 
       (Seq (Int, Int) -> (Int, Int) -> Seq (Int, Int))
-> Seq (Int, Int) -> Seq (Int, Int) -> Seq (Int, Int)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 
          (
            \Seq (Int, Int)
sq (Int
m, Int
i) -> 
              Seq (Int, Int)
sq Seq (Int, Int) -> Seq (Int, Int) -> Seq (Int, Int)
forall a. Seq a -> Seq a -> Seq a
>< 
                ((Int, Int) -> (Int, Int)) -> Seq (Int, Int) -> Seq (Int, Int)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
m', Int
j) -> (Int
m Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
j, Int
m'Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1)) (Int -> Seq (Int, Int) -> Seq (Int, Int)
forall a. Int -> Seq a -> Seq a
S.take Int
m Seq (Int, Int)
zs')
          ) 
           Seq (Int, Int)
forall a. Seq a
S.empty Seq (Int, Int)
zs

poly_from_assoc :: (Eq a, AlgRing.C a) => ((Int, Int), Int) -> Spray a
poly_from_assoc :: forall a. (Eq a, C a) => ((Int, Int), Int) -> Spray a
poly_from_assoc ((Int
a, Int
l), Int
c) = 
  ([(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList 
    [
      (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0, a
forall a. C a => a
AlgRing.one)
    , (Seq Int -> Int -> Powers
Powers (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList [Int
a, Int
l]) Int
2, a -> a
forall a. C a => a -> a
AlgAdd.negate a
forall a. C a => a
AlgRing.one)
    ]) Spray a -> Int -> Spray a
forall b. (FunctionLike b, C b) => b -> Int -> b
^**^ Int
c 

poly_from_assocs :: (Eq a, AlgRing.C a) => [((Int, Int), Int)] -> Spray a
poly_from_assocs :: forall a. (Eq a, C a) => [((Int, Int), Int)] -> Spray a
poly_from_assocs [((Int, Int), Int)]
assocs = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ((((Int, Int), Int) -> Spray a) -> [((Int, Int), Int)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), Int) -> Spray a
forall a. (Eq a, C a) => ((Int, Int), Int) -> Spray a
poly_from_assoc [((Int, Int), Int)]
assocs)

clambda :: (Eq a, AlgRing.C a) => Seq Int -> Spray a
clambda :: forall a. (Eq a, C a) => Seq Int -> Spray a
clambda Seq Int
lambda = 
  [((Int, Int), Int)] -> Spray a
forall a. (Eq a, C a) => [((Int, Int), Int)] -> Spray a
poly_from_assocs (Map (Int, Int) Int -> [((Int, Int), Int)]
forall k a. Map k a -> [(k, a)]
DM.assocs (Seq Int -> Map (Int, Int) Int
alMap Seq Int
lambda))

assocsFromMaps :: 
  Map (Int, Int) Int -> Map (Int, Int) Int 
  -> ([((Int, Int), Int)], [((Int, Int), Int)])
assocsFromMaps :: Map (Int, Int) Int
-> Map (Int, Int) Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
assocsFromMaps Map (Int, Int) Int
num_map Map (Int, Int) Int
den_map = 
  (Map (Int, Int) Int -> [((Int, Int), Int)])
-> (Map (Int, Int) Int, Map (Int, Int) Int)
-> ([((Int, Int), Int)], [((Int, Int), Int)])
forall a b. (a -> b) -> (a, a) -> (b, b)
both Map (Int, Int) Int -> [((Int, Int), Int)]
forall k a. Map k a -> [(k, a)]
DM.assocs
    (
      (Int -> Int -> Maybe Int)
-> Map (Int, Int) Int -> Map (Int, Int) Int -> Map (Int, Int) Int
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
DM.differenceWith Int -> Int -> Maybe Int
forall {a}. (Ord a, C a) => a -> a -> Maybe a
f Map (Int, Int) Int
num_map Map (Int, Int) Int
den_map
    , (Int -> Int -> Maybe Int)
-> Map (Int, Int) Int -> Map (Int, Int) Int -> Map (Int, Int) Int
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
DM.differenceWith Int -> Int -> Maybe Int
forall {a}. (Ord a, C a) => a -> a -> Maybe a
f Map (Int, Int) Int
den_map Map (Int, Int) Int
num_map
    )
  where
    f :: a -> a -> Maybe a
f a
k1 a
k2 = if a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k2 then a -> Maybe a
forall a. a -> Maybe a
Just (a
k1 a -> a -> a
forall a. C a => a -> a -> a
- a
k2) else Maybe a
forall a. Maybe a
Nothing

clambdamuAssocs :: 
  Seq Int -> Seq Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
clambdamuAssocs :: Seq Int -> Seq Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
clambdamuAssocs Seq Int
lambda Seq Int
mu = Map (Int, Int) Int
-> Map (Int, Int) Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
assocsFromMaps Map (Int, Int) Int
num_map Map (Int, Int) Int
den_map
  where
    num_map :: Map (Int, Int) Int
num_map = Seq Int -> Map (Int, Int) Int
alMap Seq Int
lambda
    den_map :: Map (Int, Int) Int
den_map = Seq Int -> Map (Int, Int) Int
alMap Seq Int
mu

clambdamu :: (Eq a, AlgField.C a) => Seq Int -> Seq Int -> RatioOfSprays a
clambdamu :: forall a. (Eq a, C a) => Seq Int -> Seq Int -> RatioOfSprays a
clambdamu Seq Int
lambda Seq Int
mu = Spray a
num Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% Spray a
den
  where
    assocs :: ([((Int, Int), Int)], [((Int, Int), Int)])
assocs = Seq Int -> Seq Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
clambdamuAssocs Seq Int
lambda Seq Int
mu
    (Spray a
num, Spray a
den) = ([((Int, Int), Int)] -> Spray a)
-> ([((Int, Int), Int)], [((Int, Int), Int)]) -> (Spray a, Spray a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both [((Int, Int), Int)] -> Spray a
forall a. (Eq a, C a) => [((Int, Int), Int)] -> Spray a
poly_from_assocs ([((Int, Int), Int)], [((Int, Int), Int)])
assocs

_dualPartition' :: Seq Int -> Seq Int
_dualPartition' :: Seq Int -> Seq Int
_dualPartition' Seq Int
Empty = Seq Int
forall a. Seq a
S.empty
_dualPartition' Seq Int
xs = Int -> Seq Int -> Seq Int -> Seq Int
forall {t}. (C t, Num t) => t -> Seq Int -> Seq Int -> Seq t
go Int
0 (Seq Int -> Seq Int
forall {a}. C a => Seq a -> Seq a
_diffSequence' Seq Int
xs) Seq Int
forall a. Seq a
S.empty where
  go :: t -> Seq Int -> Seq Int -> Seq t
go !t
i (Int
d :<| Seq Int
ds) Seq Int
acc = t -> Seq Int -> Seq Int -> Seq t
go (t
it -> t -> t
forall a. C a => a -> a -> a
+t
1) Seq Int
ds (Int
d Int -> Seq Int -> Seq Int
forall a. a -> Seq a -> Seq a
<| Seq Int
acc)
  go t
n  Seq Int
Empty      Seq Int
acc = t -> Seq Int -> Seq t
forall {t}. (C t, Num t) => t -> Seq Int -> Seq t
finish t
n Seq Int
acc 
  finish :: t -> Seq Int -> Seq t
finish !t
j (Int
k :<| Seq Int
ks) = Int -> t -> Seq t
forall a. Int -> a -> Seq a
S.replicate Int
k t
j Seq t -> Seq t -> Seq t
forall a. Seq a -> Seq a -> Seq a
>< t -> Seq Int -> Seq t
finish (t
jt -> t -> t
forall a. C a => a -> a -> a
-t
1) Seq Int
ks
  finish t
_ Seq Int
Empty       = Seq t
forall a. Seq a
S.empty
  _diffSequence' :: Seq a -> Seq a
_diffSequence' (a
x :<| ys :: Seq a
ys@(a
y :<| Seq a
_)) = (a
xa -> a -> a
forall a. C a => a -> a -> a
-a
y) a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a -> Seq a
_diffSequence' Seq a
ys 
  _diffSequence' (a
x :<| Seq a
Empty)        = a -> Seq a
forall a. a -> Seq a
S.singleton a
x
  _diffSequence' Seq a
Empty                = Seq a
forall a. Seq a
S.empty

codedRatio :: 
  PartitionsPair -> PartitionsPair -> (Int, Int) -> ([(Int,Int)], [(Int,Int)])
codedRatio :: PartitionsPair
-> PartitionsPair -> (Int, Int) -> ([(Int, Int)], [(Int, Int)])
codedRatio (Seq Int
lambda, Seq Int
lambda') (Seq Int
mu, Seq Int
mu') (Int
i, Int
j)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ellMu Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mu_im1 = 
      ([(Int
aInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1, Int
l), (Int
a', Int
l'Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1)], [(Int
a, Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1), (Int
a'Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1, Int
l')])
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lambda_im1 =
      ([(Int
a', Int
l'Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1)], [(Int
a'Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1, Int
l')])
  | Bool
otherwise = 
      ([], [])
    where
      ellMu :: Int
ellMu = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu
      mu_im1 :: Int
mu_im1 = Seq Int
mu Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
      a :: Int
a = Int
mu_im1 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
j
      l :: Int
l = Seq Int
mu' Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
jInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
i
      lambda_im1 :: Int
lambda_im1 = Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
      a' :: Int
a' = Int
lambda_im1 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
j
      l' :: Int
l' = Seq Int
lambda' Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
jInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
i

psiLambdaMu :: PartitionsPair -> ([(Int,Int)], [(Int,Int)])
psiLambdaMu :: PartitionsPair -> ([(Int, Int)], [(Int, Int)])
psiLambdaMu (Seq Int
lambda, Seq Int
mu) = 
  ([[(Int, Int)]] -> [(Int, Int)])
-> ([[(Int, Int)]], [[(Int, Int)]]) -> ([(Int, Int)], [(Int, Int)])
forall a b. (a -> b) -> (a, a) -> (b, b)
both [[(Int, Int)]] -> [(Int, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 
    ([([(Int, Int)], [(Int, Int)])] -> ([[(Int, Int)]], [[(Int, Int)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Int, Int) -> ([(Int, Int)], [(Int, Int)]))
-> [(Int, Int)] -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map (([(Int, Int)], [(Int, Int)]) -> ([(Int, Int)], [(Int, Int)])
forall a b. (a, b) -> (b, a)
swap (([(Int, Int)], [(Int, Int)]) -> ([(Int, Int)], [(Int, Int)]))
-> ((Int, Int) -> ([(Int, Int)], [(Int, Int)]))
-> (Int, Int)
-> ([(Int, Int)], [(Int, Int)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PartitionsPair
-> PartitionsPair -> (Int, Int) -> ([(Int, Int)], [(Int, Int)])
codedRatio (Seq Int
lambda, Seq Int
lambda') (Seq Int
mu, Seq Int
mu'))) [(Int, Int)]
pairs))
  where
    lambda' :: Seq Int
lambda' = Seq Int -> Seq Int
_dualPartition' Seq Int
lambda
    mu' :: Seq Int
mu' = Seq Int -> Seq Int
_dualPartition' Seq Int
mu
    ellLambda :: Int
ellLambda = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda
    ellMu :: Int
ellMu = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu
    emptyRows :: Seq Bool
emptyRows = (Int -> Int -> Bool) -> Seq Int -> Seq Int -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Seq Int
lambda Seq Int
mu
    bools' :: Seq Bool
bools' = (Int -> Int -> Bool) -> Seq Int -> Seq Int -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Seq Int
lambda' Seq Int
mu' 
    emptyColumns :: Partition
emptyColumns = Bool -> Seq Bool -> Partition
forall a. Eq a => a -> Seq a -> Partition
S.elemIndicesL Bool
True Seq Bool
bools'
    pairs :: [(Int, Int)]
pairs = [
          (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1, Int
jInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) 
          | Int
i <- [Int
0 .. Int
ellLambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1], 
            Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ellMu Bool -> Bool -> Bool
|| Bool -> Bool
not (Seq Bool
emptyRows Seq Bool -> Int -> Bool
forall a. Seq a -> Int -> a
`S.index` Int
i), 
            Int
j <- Partition
emptyColumns, Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
i
        ]

phiLambdaMu :: PartitionsPair -> ([(Int,Int)], [(Int,Int)])
phiLambdaMu :: PartitionsPair -> ([(Int, Int)], [(Int, Int)])
phiLambdaMu (Seq Int
lambda, Seq Int
mu) = 
  ([[(Int, Int)]] -> [(Int, Int)])
-> ([[(Int, Int)]], [[(Int, Int)]]) -> ([(Int, Int)], [(Int, Int)])
forall a b. (a -> b) -> (a, a) -> (b, b)
both [[(Int, Int)]] -> [(Int, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([([(Int, Int)], [(Int, Int)])] -> ([[(Int, Int)]], [[(Int, Int)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Int, Int) -> ([(Int, Int)], [(Int, Int)]))
-> [(Int, Int)] -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map (PartitionsPair
-> PartitionsPair -> (Int, Int) -> ([(Int, Int)], [(Int, Int)])
codedRatio (Seq Int
lambda, Seq Int
lambda') (Seq Int
mu, Seq Int
mu')) [(Int, Int)]
pairs))
  where
    lambda' :: Seq Int
lambda' = Seq Int -> Seq Int
_dualPartition' Seq Int
lambda
    mu' :: Seq Int
mu' = Seq Int -> Seq Int
_dualPartition' Seq Int
mu
    bools' :: Seq Bool
bools' = 
      (Int -> Int -> Bool) -> Seq Int -> Seq Int -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Seq Int
lambda' Seq Int
mu' 
        Seq Bool -> Seq Bool -> Seq Bool
forall a. Seq a -> Seq a -> Seq a
>< Int -> Bool -> Seq Bool
forall a. Int -> a -> Seq a
S.replicate (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda' Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu') Bool
False 
    nonEmptyColumns :: Partition
nonEmptyColumns = Bool -> Seq Bool -> Partition
forall a. Eq a => a -> Seq a -> Partition
S.elemIndicesL Bool
False Seq Bool
bools'
    pairs :: [(Int, Int)]
pairs = [(Int
i, Int
jInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) | Int
j <- Partition
nonEmptyColumns, Int
i <- [Int
1 .. Seq Int
lambda' Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
j]] 

makeRatioOfSprays :: 
  (Eq a, AlgField.C a) => 
  PairsMap -> [PartitionsPair] -> RatioOfSprays a
makeRatioOfSprays :: forall a.
(Eq a, C a) =>
PairsMap -> [PartitionsPair] -> RatioOfSprays a
makeRatioOfSprays PairsMap
pairsMap [PartitionsPair]
pairs = Spray a
num Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% Spray a
den
  where
    als :: (Seq (Int, Int), Seq (Int, Int))
als = 
      ([[(Int, Int)]] -> Seq (Int, Int))
-> ([[(Int, Int)]], [[(Int, Int)]])
-> (Seq (Int, Int), Seq (Int, Int))
forall a b. (a -> b) -> (a, a) -> (b, b)
both ([(Int, Int)] -> Seq (Int, Int)
forall a. [a] -> Seq a
S.fromList ([(Int, Int)] -> Seq (Int, Int))
-> ([[(Int, Int)]] -> [(Int, Int)])
-> [[(Int, Int)]]
-> Seq (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, Int)]] -> [(Int, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) 
        ([([(Int, Int)], [(Int, Int)])] -> ([[(Int, Int)]], [[(Int, Int)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (PairsMap -> [([(Int, Int)], [(Int, Int)])]
forall k a. Map k a -> [a]
DM.elems (PairsMap -> [([(Int, Int)], [(Int, Int)])])
-> PairsMap -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> a -> b
$ PairsMap -> Set PartitionsPair -> PairsMap
forall k a. Ord k => Map k a -> Set k -> Map k a
DM.restrictKeys PairsMap
pairsMap ([PartitionsPair] -> Set PartitionsPair
forall a. Ord a => [a] -> Set a
DS.fromList [PartitionsPair]
pairs)))
    (Map (Int, Int) Int
num_map, Map (Int, Int) Int
den_map) = (Seq (Int, Int) -> Map (Int, Int) Int)
-> (Seq (Int, Int), Seq (Int, Int))
-> (Map (Int, Int) Int, Map (Int, Int) Int)
forall a b. (a -> b) -> (a, a) -> (b, b)
both Seq (Int, Int) -> Map (Int, Int) Int
alMapFromPairs (Seq (Int, Int), Seq (Int, Int))
als 
    assocs :: ([((Int, Int), Int)], [((Int, Int), Int)])
assocs = Map (Int, Int) Int
-> Map (Int, Int) Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
assocsFromMaps Map (Int, Int) Int
num_map Map (Int, Int) Int
den_map
    (Spray a
num, Spray a
den) = ([((Int, Int), Int)] -> Spray a)
-> ([((Int, Int), Int)], [((Int, Int), Int)]) -> (Spray a, Spray a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both [((Int, Int), Int)] -> Spray a
forall a. (Eq a, C a) => [((Int, Int), Int)] -> Spray a
poly_from_assocs ([((Int, Int), Int)], [((Int, Int), Int)])
assocs

macdonaldJinMSPbasis :: 
  forall a. (Eq a, AlgField.C a) 
  => Partition 
  -> Map Partition (Spray a)
macdonaldJinMSPbasis :: forall a. (Eq a, C a) => Partition -> Map Partition (Spray a)
macdonaldJinMSPbasis Partition
lambda = 
  [(Partition, Spray a)] -> Map Partition (Spray a)
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList 
      ((Partition -> [[PartitionsPair]] -> (Partition, Spray a))
-> [Partition] -> [[[PartitionsPair]]] -> [(Partition, Spray a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 
        (\Partition
mu [[PartitionsPair]]
listOfPairs -> 
          (
            Partition -> Partition
fromPartition Partition
mu
          , RatioOfSprays a -> Spray a
forall a. RatioOfSprays a -> Spray a
_numerator 
              (Spray a
c Spray a -> RatioOfSprays a -> RatioOfSprays a
forall a v. C a v => a -> v -> v
*> 
                [RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum 
                  (([PartitionsPair] -> RatioOfSprays a)
-> [[PartitionsPair]] -> [RatioOfSprays a]
forall a b. (a -> b) -> [a] -> [b]
map (PairsMap -> [PartitionsPair] -> RatioOfSprays a
forall a.
(Eq a, C a) =>
PairsMap -> [PartitionsPair] -> RatioOfSprays a
makeRatioOfSprays PairsMap
pairsMap) [[PartitionsPair]]
listOfPairs) 
                    :: RatioOfSprays a
              )
          )
        ) [Partition]
mus [[[PartitionsPair]]]
listsOfPairs
      )
  where
    c :: Spray a
c = 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
    lambda' :: Partition
lambda' = Partition -> Partition
toPartitionUnsafe Partition
lambda
    mus :: [Partition]
mus = Partition -> [Partition]
dominatedPartitions Partition
lambda'
    pairing :: [b] -> [(b, b)]
pairing [b]
lambdas = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([b] -> [b]
forall a. [a] -> [a]
drop1 [b]
lambdas) [b]
lambdas
    listsOfPairs :: [[[PartitionsPair]]]
listsOfPairs = 
      (Partition -> [[PartitionsPair]])
-> [Partition] -> [[[PartitionsPair]]]
forall a b. (a -> b) -> [a] -> [b]
map (
        ([Partition] -> [PartitionsPair])
-> [[Partition]] -> [[PartitionsPair]]
forall a b. (a -> b) -> [a] -> [b]
map ([Seq Int] -> [PartitionsPair]
forall {b}. [b] -> [(b, b)]
pairing ([Seq Int] -> [PartitionsPair])
-> ([Partition] -> [Seq Int]) -> [Partition] -> [PartitionsPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Partition] -> [Seq Int]
gtPatternDiagonals') 
          ([[Partition]] -> [[PartitionsPair]])
-> (Partition -> [[Partition]]) -> Partition -> [[PartitionsPair]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition -> Partition -> [[Partition]]
kostkaGelfandTsetlinPatterns Partition
lambda')
      ) [Partition]
mus
    allPairs :: [PartitionsPair]
allPairs = [PartitionsPair] -> [PartitionsPair]
forall a. Eq a => [a] -> [a]
nub ([PartitionsPair] -> [PartitionsPair])
-> [PartitionsPair] -> [PartitionsPair]
forall a b. (a -> b) -> a -> b
$ [[PartitionsPair]] -> [PartitionsPair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[PartitionsPair]]] -> [[PartitionsPair]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[PartitionsPair]]]
listsOfPairs)
    pairsMap :: PairsMap
pairsMap = [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))] -> PairsMap
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ([PartitionsPair]
-> [([(Int, Int)], [(Int, Int)])]
-> [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PartitionsPair]
allPairs ((PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> [PartitionsPair] -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map PartitionsPair -> ([(Int, Int)], [(Int, Int)])
psiLambdaMu [PartitionsPair]
allPairs))

-- skewMacdonaldJinMSPbasis :: 

--   forall a. (Eq a, AlgField.C a) 

--   => Partition 

--   -> Partition

--   -> Map Partition (RatioOfSprays a)

-- skewMacdonaldJinMSPbasis lambda mu = 

--   DM.map (((^*^) c) . AlgAdd.sum . (map (makeRatioOfSprays pairsMap))) mapOfPairs

--   where

--     nus = 

--       dominatedPartitions 

--         (toPartitionUnsafe (lastSubPartition (sum lambda - sum mu) lambda))

--     pairing lambdas = zip (drop1 lambdas) lambdas

--     mapOfPatterns = DM.filter (not . null) 

--       (DM.fromList (map (\nu -> 

--         let nu' = fromPartition nu in

--           (

--             nu'

--           , _skewGelfandTsetlinPatterns lambda mu nu'

--           )        

--         ) nus))

--     mapOfPairs = DM.map (map pairing) mapOfPatterns

--     listsOfPairs = DM.elems mapOfPairs

--     allPairs = nub $ concat (concat listsOfPairs)

--     pairsMap = DM.fromList (zip allPairs (map psiLambdaMu allPairs))

--     c = clambdamu (S.fromList lambda) (S.fromList mu) :: RatioOfSprays a  


_macdonaldPolynomial :: 
  (Eq a, AlgField.C a) 
  => (PartitionsPair -> ([(Int,Int)], [(Int,Int)]))
  -> Int 
  -> Partition 
  -> ParametricSpray a
_macdonaldPolynomial :: forall a.
(Eq a, C a) =>
(PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> ParametricSpray a
_macdonaldPolynomial PartitionsPair -> ([(Int, Int)], [(Int, Int)])
f Int
n Partition
lambda = [HashMap Powers (RatioOfSprays a)]
-> HashMap Powers (RatioOfSprays a)
forall k v. Eq k => [HashMap k v] -> HashMap k v
HM.unions [HashMap Powers (RatioOfSprays a)]
hashMaps
  where
    lambda' :: Partition
lambda' = Partition -> Partition
toPartitionUnsafe Partition
lambda
    mus :: [Partition]
mus = (Partition -> Bool) -> [Partition] -> [Partition]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Partition
mu -> Partition -> Int
partitionWidth Partition
mu Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Partition -> [Partition]
dominatedPartitions Partition
lambda')
    pairing :: [b] -> [(b, b)]
pairing [b]
lambdas = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([b] -> [b]
forall a. [a] -> [a]
drop1 [b]
lambdas) [b]
lambdas
    listsOfPairs :: [[[PartitionsPair]]]
listsOfPairs = 
      (Partition -> [[PartitionsPair]])
-> [Partition] -> [[[PartitionsPair]]]
forall a b. (a -> b) -> [a] -> [b]
map (
        ([Partition] -> [PartitionsPair])
-> [[Partition]] -> [[PartitionsPair]]
forall a b. (a -> b) -> [a] -> [b]
map ([Seq Int] -> [PartitionsPair]
forall {b}. [b] -> [(b, b)]
pairing ([Seq Int] -> [PartitionsPair])
-> ([Partition] -> [Seq Int]) -> [Partition] -> [PartitionsPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Partition] -> [Seq Int]
gtPatternDiagonals') 
          ([[Partition]] -> [[PartitionsPair]])
-> (Partition -> [[Partition]]) -> Partition -> [[PartitionsPair]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition -> Partition -> [[Partition]]
kostkaGelfandTsetlinPatterns Partition
lambda')
      ) [Partition]
mus
    allPairs :: [PartitionsPair]
allPairs = [PartitionsPair] -> [PartitionsPair]
forall a. Eq a => [a] -> [a]
nub ([PartitionsPair] -> [PartitionsPair])
-> [PartitionsPair] -> [PartitionsPair]
forall a b. (a -> b) -> a -> b
$ [[PartitionsPair]] -> [PartitionsPair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[PartitionsPair]]] -> [[PartitionsPair]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[PartitionsPair]]]
listsOfPairs)
    pairsMap :: PairsMap
pairsMap = [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))] -> PairsMap
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ([PartitionsPair]
-> [([(Int, Int)], [(Int, Int)])]
-> [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PartitionsPair]
allPairs ((PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> [PartitionsPair] -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map PartitionsPair -> ([(Int, Int)], [(Int, Int)])
f [PartitionsPair]
allPairs))
    coeffs :: HashMap (Seq Int) (RatioOfSprays a)
coeffs = [(Seq Int, RatioOfSprays a)] -> HashMap (Seq Int) (RatioOfSprays a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList 
      ((Partition -> [[PartitionsPair]] -> (Seq Int, RatioOfSprays a))
-> [Partition]
-> [[[PartitionsPair]]]
-> [(Seq Int, RatioOfSprays a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 
        (\Partition
mu [[PartitionsPair]]
listOfPairs -> 
          (
            Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList (Partition -> Partition
fromPartition Partition
mu)
          , [RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum (([PartitionsPair] -> RatioOfSprays a)
-> [[PartitionsPair]] -> [RatioOfSprays a]
forall a b. (a -> b) -> [a] -> [b]
map (PairsMap -> [PartitionsPair] -> RatioOfSprays a
forall a.
(Eq a, C a) =>
PairsMap -> [PartitionsPair] -> RatioOfSprays a
makeRatioOfSprays PairsMap
pairsMap) [[PartitionsPair]]
listOfPairs)
          )
        ) [Partition]
mus [[[PartitionsPair]]]
listsOfPairs
      )
    dropTrailingZeros :: Seq Int -> Seq Int
dropTrailingZeros = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.dropWhileR (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    hashMaps :: [HashMap Powers (RatioOfSprays a)]
hashMaps = 
      (Partition -> HashMap Powers (RatioOfSprays a))
-> [Partition] -> [HashMap Powers (RatioOfSprays a)]
forall a b. (a -> b) -> [a] -> [b]
map 
        (\Partition
mu -> 
          let mu' :: Partition
mu' = Partition -> Partition
fromPartition Partition
mu
              mu'' :: Seq Int
mu'' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu'
              mu''' :: Partition
mu''' = Partition
mu' Partition -> Partition -> Partition
forall a. [a] -> [a] -> [a]
++ (Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu'') Int
0)
              coeff :: RatioOfSprays a
coeff = HashMap (Seq Int) (RatioOfSprays a)
coeffs HashMap (Seq Int) (RatioOfSprays a) -> Seq Int -> RatioOfSprays a
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Seq Int
mu''
              compos :: [Partition]
compos = Partition -> [Partition]
forall a. (Eq a, Ord a) => [a] -> [[a]]
permuteMultiset Partition
mu'''
          in
            [(Powers, RatioOfSprays a)] -> HashMap Powers (RatioOfSprays a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList 
              [let compo' :: Seq Int
compo' = Seq Int -> Seq Int
dropTrailingZeros (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
compo) in
                (Seq Int -> Int -> Powers
Powers Seq Int
compo' (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
compo'), RatioOfSprays a
coeff) | Partition
compo <- [Partition]
compos]
        ) [Partition]
mus

macdonaldPolynomialP :: 
  (Eq a, AlgField.C a) => Int -> Partition -> ParametricSpray a
macdonaldPolynomialP :: forall a. (Eq a, C a) => Int -> Partition -> ParametricSpray a
macdonaldPolynomialP = (PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> ParametricSpray a
forall a.
(Eq a, C a) =>
(PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> ParametricSpray a
_macdonaldPolynomial PartitionsPair -> ([(Int, Int)], [(Int, Int)])
psiLambdaMu 

macdonaldPolynomialQ :: 
  (Eq a, AlgField.C a) => Int -> Partition -> ParametricSpray a
macdonaldPolynomialQ :: forall a. (Eq a, C a) => Int -> Partition -> ParametricSpray a
macdonaldPolynomialQ = (PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> ParametricSpray a
forall a.
(Eq a, C a) =>
(PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> ParametricSpray a
_macdonaldPolynomial PartitionsPair -> ([(Int, Int)], [(Int, Int)])
phiLambdaMu 

lastSubPartition :: Int -> Partition -> Partition
-- assumes w <= sum(k:ks)

lastSubPartition :: Int -> Partition -> Partition
lastSubPartition Int
0 Partition
_  = []
lastSubPartition Int
_ [] = []
lastSubPartition Int
w (Int
k:Partition
ks) =  
  if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k then [Int
w] else Int
k Int -> Partition -> Partition
forall a. a -> [a] -> [a]
: Int -> Partition -> Partition
lastSubPartition (Int
w Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
k) Partition
ks

_skewJackInMSPbasis :: 
  forall a. (AlgRing.C a) 
  => (([((Int, Int), Int)], [((Int, Int), Int)]) -> a)
  -> (Partition -> Partition -> a)
  -> Char
  -> Partition 
  -> Partition
  -> Map Partition (Int, a)
_skewJackInMSPbasis :: forall a.
C a =>
(([((Int, Int), Int)], [((Int, Int), Int)]) -> a)
-> (Partition -> Partition -> a)
-> Char
-> Partition
-> Partition
-> Map Partition (Int, a)
_skewJackInMSPbasis ([((Int, Int), Int)], [((Int, Int), Int)]) -> a
func Partition -> Partition -> a
ccoeff Char
which Partition
lambda Partition
mu = 
  (Partition -> [[PartitionsPair]] -> (Int, a))
-> Map Partition [[PartitionsPair]] -> Map Partition (Int, a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey 
    (\Partition
nu [[PartitionsPair]]
listOfPairs -> (Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu, [[PartitionsPair]] -> a
makeCoeffFromListOfPairs [[PartitionsPair]]
listOfPairs)) 
      Map Partition [[PartitionsPair]]
mapOfPairs
  where
    nus :: [Partition]
nus = 
      Partition -> [Partition]
dominatedPartitions 
        (Partition -> Partition
toPartitionUnsafe (Int -> Partition -> Partition
lastSubPartition (Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Partition -> Int
forall a. C a => [a] -> a
sum Partition
mu) Partition
lambda))
    pairing :: [b] -> [(b, b)]
pairing [b]
lambdas = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([b] -> [b]
forall a. [a] -> [a]
drop1 [b]
lambdas) [b]
lambdas
    mapOfPatterns :: Map Partition [[Seq Int]]
mapOfPatterns = ([[Seq Int]] -> Bool)
-> Map Partition [[Seq Int]] -> Map Partition [[Seq Int]]
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (Bool -> Bool
not (Bool -> Bool) -> ([[Seq Int]] -> Bool) -> [[Seq Int]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Seq Int]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) 
      ([(Partition, [[Seq Int]])] -> Map Partition [[Seq Int]]
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ((Partition -> (Partition, [[Seq Int]]))
-> [Partition] -> [(Partition, [[Seq Int]])]
forall a b. (a -> b) -> [a] -> [b]
map (\Partition
nu -> 
        let nu' :: Partition
nu' = Partition -> Partition
fromPartition Partition
nu in
          (
            Partition
nu'
          , Partition -> Partition -> Partition -> [[Seq Int]]
_skewGelfandTsetlinPatterns Partition
lambda Partition
mu Partition
nu'
          )        
        ) [Partition]
nus))
    mapOfPairs :: Map Partition [[PartitionsPair]]
mapOfPairs = ([[Seq Int]] -> [[PartitionsPair]])
-> Map Partition [[Seq Int]] -> Map Partition [[PartitionsPair]]
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (([Seq Int] -> [PartitionsPair])
-> [[Seq Int]] -> [[PartitionsPair]]
forall a b. (a -> b) -> [a] -> [b]
map [Seq Int] -> [PartitionsPair]
forall {b}. [b] -> [(b, b)]
pairing) Map Partition [[Seq Int]]
mapOfPatterns
    listsOfPairs :: [[[PartitionsPair]]]
listsOfPairs = Map Partition [[PartitionsPair]] -> [[[PartitionsPair]]]
forall k a. Map k a -> [a]
DM.elems Map Partition [[PartitionsPair]]
mapOfPairs
    allPairs :: [PartitionsPair]
allPairs = [PartitionsPair] -> [PartitionsPair]
forall a. Eq a => [a] -> [a]
nub ([PartitionsPair] -> [PartitionsPair])
-> [PartitionsPair] -> [PartitionsPair]
forall a b. (a -> b) -> a -> b
$ [[PartitionsPair]] -> [PartitionsPair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[PartitionsPair]]] -> [[PartitionsPair]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[PartitionsPair]]]
listsOfPairs)
    funcLambdaMu :: PartitionsPair -> ([(Int, Int)], [(Int, Int)])
funcLambdaMu = if Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Q' then PartitionsPair -> ([(Int, Int)], [(Int, Int)])
phiLambdaMu else PartitionsPair -> ([(Int, Int)], [(Int, Int)])
psiLambdaMu
    pairsMap :: PairsMap
pairsMap = 
      [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))] -> PairsMap
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ([PartitionsPair]
-> [([(Int, Int)], [(Int, Int)])]
-> [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PartitionsPair]
allPairs ((PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> [PartitionsPair] -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map PartitionsPair -> ([(Int, Int)], [(Int, Int)])
funcLambdaMu [PartitionsPair]
allPairs))
    makeAssocsFromPairs :: 
      [PartitionsPair] -> ([((Int, Int), Int)], [((Int, Int), Int)]) 
    makeAssocsFromPairs :: [PartitionsPair] -> ([((Int, Int), Int)], [((Int, Int), Int)])
makeAssocsFromPairs [PartitionsPair]
pairs = Map (Int, Int) Int
-> Map (Int, Int) Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
assocsFromMaps Map (Int, Int) Int
num_map Map (Int, Int) Int
den_map
      where
        als :: (Seq (Int, Int), Seq (Int, Int))
als = 
          ([[(Int, Int)]] -> Seq (Int, Int))
-> ([[(Int, Int)]], [[(Int, Int)]])
-> (Seq (Int, Int), Seq (Int, Int))
forall a b. (a -> b) -> (a, a) -> (b, b)
both ([(Int, Int)] -> Seq (Int, Int)
forall a. [a] -> Seq a
S.fromList ([(Int, Int)] -> Seq (Int, Int))
-> ([[(Int, Int)]] -> [(Int, Int)])
-> [[(Int, Int)]]
-> Seq (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, Int)]] -> [(Int, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) 
            ([([(Int, Int)], [(Int, Int)])] -> ([[(Int, Int)]], [[(Int, Int)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (PairsMap -> [([(Int, Int)], [(Int, Int)])]
forall k a. Map k a -> [a]
DM.elems (PairsMap -> [([(Int, Int)], [(Int, Int)])])
-> PairsMap -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> a -> b
$ PairsMap -> Set PartitionsPair -> PairsMap
forall k a. Ord k => Map k a -> Set k -> Map k a
DM.restrictKeys PairsMap
pairsMap ([PartitionsPair] -> Set PartitionsPair
forall a. Ord a => [a] -> Set a
DS.fromList [PartitionsPair]
pairs)))
        (Map (Int, Int) Int
num_map, Map (Int, Int) Int
den_map) = (Seq (Int, Int) -> Map (Int, Int) Int)
-> (Seq (Int, Int), Seq (Int, Int))
-> (Map (Int, Int) Int, Map (Int, Int) Int)
forall a b. (a -> b) -> (a, a) -> (b, b)
both Seq (Int, Int) -> Map (Int, Int) Int
alMapFromPairs (Seq (Int, Int), Seq (Int, Int))
als 
    makeCoeffFromListOfPairs :: [[PartitionsPair]] -> a
    makeCoeffFromListOfPairs :: [[PartitionsPair]] -> a
makeCoeffFromListOfPairs [[PartitionsPair]]
listOfPairs  
      | Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'J' =
          a
c a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
coeff
      | Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' = 
          Partition -> Partition -> a
ccoeff Partition
lambda Partition
mu a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
c a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
coeff
      | Bool
otherwise =
          a
coeff
      where
        c :: a
c = ([((Int, Int), Int)], [((Int, Int), Int)]) -> a
func (Seq Int -> Seq Int -> ([((Int, Int), Int)], [((Int, Int), Int)])
clambdamuAssocs (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda) (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu))
        coeff :: a
coeff = [a] -> a
forall a. C a => [a] -> a
AlgAdd.sum (([PartitionsPair] -> a) -> [[PartitionsPair]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (([((Int, Int), Int)], [((Int, Int), Int)]) -> a
func (([((Int, Int), Int)], [((Int, Int), Int)]) -> a)
-> ([PartitionsPair] -> ([((Int, Int), Int)], [((Int, Int), Int)]))
-> [PartitionsPair]
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PartitionsPair] -> ([((Int, Int), Int)], [((Int, Int), Int)])
makeAssocsFromPairs) [[PartitionsPair]]
listOfPairs) 

skewSymbolicJackInMSPbasis :: 
  (Eq a, AlgField.C a) 
  => Char
  -> Partition 
  -> Partition
  -> Map Partition (Int, RatioOfSprays a)
skewSymbolicJackInMSPbasis :: forall a.
(Eq a, C a) =>
Char
-> Partition -> Partition -> Map Partition (Int, RatioOfSprays a)
skewSymbolicJackInMSPbasis = 
  (([((Int, Int), Int)], [((Int, Int), Int)]) -> RatioOfSprays a)
-> (Partition -> Partition -> RatioOfSprays a)
-> Char
-> Partition
-> Partition
-> Map Partition (Int, RatioOfSprays a)
forall a.
C a =>
(([((Int, Int), Int)], [((Int, Int), Int)]) -> a)
-> (Partition -> Partition -> a)
-> Char
-> Partition
-> Partition
-> Map Partition (Int, a)
_skewJackInMSPbasis ([((Int, Int), Int)], [((Int, Int), Int)]) -> RatioOfSprays a
rosFromAssocs Partition -> Partition -> RatioOfSprays a
forall {a}.
(Eq a, C a) =>
Partition -> Partition -> RatioOfSprays a
ccoeff
  where
    alpha :: Spray a
alpha = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
1
    poly :: ((Int, Int), Int) -> Spray a
poly ((Int
a, Int
l), Int
c) = (Int
a Int -> Spray a -> Spray a
forall a. (C a, Eq a) => Int -> a -> a
.^ Spray a
alpha Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ (Int -> a
forall a. (C a, Eq a) => Int -> a
_fromInt Int
l)) Spray a -> Int -> Spray a
forall b. (FunctionLike b, C b) => b -> Int -> b
^**^ Int
c
    rosFromAssocs :: ([((Int, Int), Int)], [((Int, Int), Int)]) -> RatioOfSprays a
rosFromAssocs ([((Int, Int), Int)], [((Int, Int), Int)])
assocs = Spray a
num Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% Spray a
den
      where
        (Spray a
num, Spray a
den) = ([((Int, Int), Int)] -> Spray a)
-> ([((Int, Int), Int)], [((Int, Int), Int)]) -> (Spray a, Spray a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both ([Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays ([Spray a] -> Spray a)
-> ([((Int, Int), Int)] -> [Spray a])
-> [((Int, Int), Int)]
-> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((((Int, Int), Int) -> Spray a) -> [((Int, Int), Int)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), Int) -> Spray a
poly)) ([((Int, Int), Int)], [((Int, Int), Int)])
assocs
    ccoeff :: Partition -> Partition -> RatioOfSprays a
ccoeff Partition
lambda Partition
mu = Partition -> RatioOfSprays a
forall a. (Eq a, C a) => Partition -> RatioOfSprays a
jackSymbolicCoeffC Partition
lambda RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
AlgField./ Partition -> RatioOfSprays a
forall a. (Eq a, C a) => Partition -> RatioOfSprays a
jackSymbolicCoeffC Partition
mu

skewJackInMSPbasis :: 
  (Eq a, AlgField.C a) 
  => a
  -> Char
  -> Partition 
  -> Partition
  -> Map Partition (Int, a)
skewJackInMSPbasis :: forall a.
(Eq a, C a) =>
a -> Char -> Partition -> Partition -> Map Partition (Int, a)
skewJackInMSPbasis a
alpha = 
  (([((Int, Int), Int)], [((Int, Int), Int)]) -> a)
-> (Partition -> Partition -> a)
-> Char
-> Partition
-> Partition
-> Map Partition (Int, a)
forall a.
C a =>
(([((Int, Int), Int)], [((Int, Int), Int)]) -> a)
-> (Partition -> Partition -> a)
-> Char
-> Partition
-> Partition
-> Map Partition (Int, a)
_skewJackInMSPbasis ([((Int, Int), Int)], [((Int, Int), Int)]) -> a
forall {a}.
Integral a =>
([((Int, Int), a)], [((Int, Int), a)]) -> a
ratioFromAssocs Partition -> Partition -> a
ccoeff
  where
    coeff :: ((Int, Int), a) -> a
coeff ((Int
a, Int
l), a
c) = 
      (Int
a Int -> a -> a
forall a. (C a, Eq a) => Int -> a -> a
.^ a
alpha a -> a -> a
forall a. C a => a -> a -> a
AlgAdd.+ (Int -> a
forall a. (C a, Eq a) => Int -> a
_fromInt Int
l)) a -> Integer -> a
forall a. C a => a -> Integer -> a
AlgRing.^ (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
c)
    ratioFromAssocs :: ([((Int, Int), a)], [((Int, Int), a)]) -> a
ratioFromAssocs ([((Int, Int), a)], [((Int, Int), a)])
assocs = a
num a -> a -> a
forall a. C a => a -> a -> a
AlgField./ a
den
      where
        (a
num, a
den) = ([((Int, Int), a)] -> a)
-> ([((Int, Int), a)], [((Int, Int), a)]) -> (a, a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both ([a] -> a
forall a. C a => [a] -> a
AlgRing.product ([a] -> a) -> ([((Int, Int), a)] -> [a]) -> [((Int, Int), a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((((Int, Int), a) -> a) -> [((Int, Int), a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), a) -> a
forall {a}. Integral a => ((Int, Int), a) -> a
coeff)) ([((Int, Int), a)], [((Int, Int), a)])
assocs
    ccoeff :: Partition -> Partition -> a
ccoeff Partition
lambda Partition
mu = Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffC Partition
lambda a
alpha a -> a -> a
forall a. C a => a -> a -> a
AlgField./ Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffC Partition
mu a
alpha

_skewMacdonaldPolynomial :: 
  (Eq a, AlgField.C a) 
  => (PartitionsPair -> ([(Int,Int)], [(Int,Int)]))
  -> Int 
  -> Partition 
  -> Partition
  -> ParametricSpray a
_skewMacdonaldPolynomial :: forall a.
(Eq a, C a) =>
(PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> Partition -> ParametricSpray a
_skewMacdonaldPolynomial PartitionsPair -> ([(Int, Int)], [(Int, Int)])
f Int
n Partition
lambda Partition
mu = [HashMap Powers (RatioOfSprays a)]
-> HashMap Powers (RatioOfSprays a)
forall k v. Eq k => [HashMap k v] -> HashMap k v
HM.unions [HashMap Powers (RatioOfSprays a)]
hashMaps
  where
    nus :: [Partition]
nus = 
      (Partition -> Bool) -> [Partition] -> [Partition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Int -> Bool) -> (Partition -> Int) -> Partition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> Int
partitionWidth) ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ 
        Partition -> [Partition]
dominatedPartitions 
          (Partition -> Partition
toPartitionUnsafe (Int -> Partition -> Partition
lastSubPartition (Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Partition -> Int
forall a. C a => [a] -> a
sum Partition
mu) Partition
lambda))
    pairing :: [b] -> [(b, b)]
pairing [b]
lambdas = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([b] -> [b]
forall a. [a] -> [a]
drop1 [b]
lambdas) [b]
lambdas
    mapOfPatterns :: HashMap (Seq Int) [[Seq Int]]
mapOfPatterns = ([[Seq Int]] -> Bool)
-> HashMap (Seq Int) [[Seq Int]] -> HashMap (Seq Int) [[Seq Int]]
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (Bool -> Bool
not (Bool -> Bool) -> ([[Seq Int]] -> Bool) -> [[Seq Int]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Seq Int]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) 
      ([(Seq Int, [[Seq Int]])] -> HashMap (Seq Int) [[Seq Int]]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ((Partition -> (Seq Int, [[Seq Int]]))
-> [Partition] -> [(Seq Int, [[Seq Int]])]
forall a b. (a -> b) -> [a] -> [b]
map (\Partition
nu -> 
        let nu' :: Partition
nu' = Partition -> Partition
fromPartition Partition
nu in
          (
            Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
nu'
          , Partition -> Partition -> Partition -> [[Seq Int]]
_skewGelfandTsetlinPatterns Partition
lambda Partition
mu Partition
nu'
          )        
        ) [Partition]
nus))
    mapOfPairs :: HashMap (Seq Int) [[PartitionsPair]]
mapOfPairs = ([[Seq Int]] -> [[PartitionsPair]])
-> HashMap (Seq Int) [[Seq Int]]
-> HashMap (Seq Int) [[PartitionsPair]]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (([Seq Int] -> [PartitionsPair])
-> [[Seq Int]] -> [[PartitionsPair]]
forall a b. (a -> b) -> [a] -> [b]
map [Seq Int] -> [PartitionsPair]
forall {b}. [b] -> [(b, b)]
pairing) HashMap (Seq Int) [[Seq Int]]
mapOfPatterns
    listsOfPairs :: [[[PartitionsPair]]]
listsOfPairs = HashMap (Seq Int) [[PartitionsPair]] -> [[[PartitionsPair]]]
forall k v. HashMap k v -> [v]
HM.elems HashMap (Seq Int) [[PartitionsPair]]
mapOfPairs
    allPairs :: [PartitionsPair]
allPairs = [PartitionsPair] -> [PartitionsPair]
forall a. Eq a => [a] -> [a]
nub ([PartitionsPair] -> [PartitionsPair])
-> [PartitionsPair] -> [PartitionsPair]
forall a b. (a -> b) -> a -> b
$ [[PartitionsPair]] -> [PartitionsPair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[PartitionsPair]]] -> [[PartitionsPair]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[PartitionsPair]]]
listsOfPairs)
    pairsMap :: PairsMap
pairsMap = [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))] -> PairsMap
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ([PartitionsPair]
-> [([(Int, Int)], [(Int, Int)])]
-> [(PartitionsPair, ([(Int, Int)], [(Int, Int)]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PartitionsPair]
allPairs ((PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> [PartitionsPair] -> [([(Int, Int)], [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map PartitionsPair -> ([(Int, Int)], [(Int, Int)])
f [PartitionsPair]
allPairs))
    coeffs :: HashMap (Seq Int) (RatioOfSprays a)
coeffs = 
      ([[PartitionsPair]] -> RatioOfSprays a)
-> HashMap (Seq Int) [[PartitionsPair]]
-> HashMap (Seq Int) (RatioOfSprays a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map ([RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum ([RatioOfSprays a] -> RatioOfSprays a)
-> ([[PartitionsPair]] -> [RatioOfSprays a])
-> [[PartitionsPair]]
-> RatioOfSprays a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([PartitionsPair] -> RatioOfSprays a)
-> [[PartitionsPair]] -> [RatioOfSprays a]
forall a b. (a -> b) -> [a] -> [b]
map (PairsMap -> [PartitionsPair] -> RatioOfSprays a
forall a.
(Eq a, C a) =>
PairsMap -> [PartitionsPair] -> RatioOfSprays a
makeRatioOfSprays PairsMap
pairsMap))) HashMap (Seq Int) [[PartitionsPair]]
mapOfPairs
    dropTrailingZeros :: Seq Int -> Seq Int
dropTrailingZeros = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.dropWhileR (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    hashMaps :: [HashMap Powers (RatioOfSprays a)]
hashMaps = 
      (Seq Int -> HashMap Powers (RatioOfSprays a))
-> [Seq Int] -> [HashMap Powers (RatioOfSprays a)]
forall a b. (a -> b) -> [a] -> [b]
map 
        (\Seq Int
nu'' -> 
          let nu''' :: Partition
nu''' = Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int
nu'' Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< (Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
nu'') Int
0))
              coeff :: RatioOfSprays a
coeff = HashMap (Seq Int) (RatioOfSprays a)
coeffs HashMap (Seq Int) (RatioOfSprays a) -> Seq Int -> RatioOfSprays a
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Seq Int
nu''
              compos :: [Partition]
compos = Partition -> [Partition]
forall a. (Eq a, Ord a) => [a] -> [[a]]
permuteMultiset Partition
nu'''
          in
            [(Powers, RatioOfSprays a)] -> HashMap Powers (RatioOfSprays a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList 
              [let compo' :: Seq Int
compo' = Seq Int -> Seq Int
dropTrailingZeros (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
compo) in
                (Seq Int -> Int -> Powers
Powers Seq Int
compo' (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
compo'), RatioOfSprays a
coeff) | Partition
compo <- [Partition]
compos]
        ) (HashMap (Seq Int) (RatioOfSprays a) -> [Seq Int]
forall k v. HashMap k v -> [k]
HM.keys HashMap (Seq Int) (RatioOfSprays a)
coeffs)

skewMacdonaldPolynomialP :: 
  (Eq a, AlgField.C a) => Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldPolynomialP :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldPolynomialP = (PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> Partition -> ParametricSpray a
forall a.
(Eq a, C a) =>
(PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> Partition -> ParametricSpray a
_skewMacdonaldPolynomial PartitionsPair -> ([(Int, Int)], [(Int, Int)])
psiLambdaMu 

skewMacdonaldPolynomialQ :: 
  (Eq a, AlgField.C a) => Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldPolynomialQ :: forall a.
(Eq a, C a) =>
Int -> Partition -> Partition -> ParametricSpray a
skewMacdonaldPolynomialQ = (PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> Partition -> ParametricSpray a
forall a.
(Eq a, C a) =>
(PartitionsPair -> ([(Int, Int)], [(Int, Int)]))
-> Int -> Partition -> Partition -> ParametricSpray a
_skewMacdonaldPolynomial PartitionsPair -> ([(Int, Int)], [(Int, Int)])
phiLambdaMu 

sandwichedPartitions :: Int -> Seq Int -> Seq Int -> [Seq Int]
sandwichedPartitions :: Int -> Seq Int -> Seq Int -> [Seq Int]
sandwichedPartitions Int
weight Seq Int
mu Seq Int
lambda = 
  Int -> Int -> Seq Int -> Seq Int -> [Seq Int]
recursiveFun Int
weight (Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0) Seq Int
mu Seq Int
lambda
  where
    recursiveFun :: Int -> Int -> Seq Int -> Seq Int -> [Seq Int]
    recursiveFun :: Int -> Int -> Seq Int -> Seq Int -> [Seq Int]
recursiveFun Int
d Int
h0 Seq Int
a_as Seq Int
b_bs
      | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
a_as Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
b_bs = []
      | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Seq Int
forall a. Seq a
S.empty]
      | Bool
otherwise = 
          (Int -> [Seq Int]) -> Partition -> [Seq Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 
            (\Int
h -> 
              [Int
h Int -> Seq Int -> Seq Int
forall a. a -> Seq a -> Seq a
:<| Seq Int
hs | Seq Int
hs <- Int -> Int -> Seq Int -> Seq Int -> [Seq Int]
recursiveFun (Int
dInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
h) Int
h Seq Int
as Seq Int
bs]
            )
            [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
a .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
h0 Int
b]
          where
            a :: Int
a = Seq Int
a_as Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0
            b :: Int
b = Seq Int
b_bs Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0
            as :: Seq Int
as = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
1 Seq Int
a_as
            bs :: Seq Int
bs = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
1 Seq Int
b_bs

_skewGelfandTsetlinPatterns :: Partition -> Partition -> [Int] -> [[Seq Int]]
_skewGelfandTsetlinPatterns :: Partition -> Partition -> Partition -> [[Seq Int]]
_skewGelfandTsetlinPatterns Partition
lambda Partition
mu Partition
weight 
  | (Int -> Bool) -> Partition -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) Partition
weight =
      []
  | Int
wWeight Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
wLambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
wMu = 
      []
  | Int
wWeight Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      [Int -> Seq Int -> [Seq Int]
forall a. Int -> a -> [a]
replicate (Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
weight Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1) Seq Int
lambda']
  | Bool
otherwise =
      if (Int -> Bool) -> Partition -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Partition
weight 
        then (Seq (Seq Int) -> [Seq Int]) -> [Seq (Seq Int)] -> [[Seq Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq (Seq Int)
pattern -> [Seq (Seq Int)
pattern Seq (Seq Int) -> Int -> Seq Int
forall a. Seq a -> Int -> a
`S.index` Int
i | Int
i <- Partition
indices]) [Seq (Seq Int)]
patterns
        else (Seq (Seq Int) -> [Seq Int]) -> [Seq (Seq Int)] -> [[Seq Int]]
forall a b. (a -> b) -> [a] -> [b]
map Seq (Seq Int) -> [Seq Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList [Seq (Seq Int)]
patterns
  where
    lambda' :: Seq Int
lambda' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
lambda
    ellLambda :: Int
ellLambda = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda'
    wLambda :: Int
wLambda = Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
lambda'
    mu' :: Seq Int
mu' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu
    ellMu :: Int
ellMu = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu'
    wMu :: Int
wMu = Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
mu'
    weight' :: Seq Int
weight' = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
weight)
    wWeight :: Int
wWeight = Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
weight'
    mu'' :: Seq Int
mu'' = Seq Int
mu' Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< (Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
ellLambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
ellMu) Int
0)
    recursiveFun :: Seq Int -> Seq Int -> [Seq (Seq Int)]
    recursiveFun :: Seq Int -> Seq Int -> [Seq (Seq Int)]
recursiveFun Seq Int
kappa Seq Int
w =
      if Int
ellW Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
        then
          [Seq Int -> Seq (Seq Int)
forall a. a -> Seq a
S.singleton Seq Int
mu']
        else 
          if Int
ellW Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ellLambda Bool -> Bool -> Bool
&& Seq Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Int -> Int -> Bool) -> Seq Int -> Seq Int -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<) Seq Int
mu' (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
ellW Seq Int
kappa))
            then []
            else 
              (Seq Int -> [Seq (Seq Int)]) -> [Seq Int] -> [Seq (Seq Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                (\Seq Int
nu -> [Seq (Seq Int)
list Seq (Seq Int) -> Seq Int -> Seq (Seq Int)
forall a. Seq a -> a -> Seq a
|> Seq Int
kappa | Seq (Seq Int)
list <- Seq Int -> Seq Int -> [Seq (Seq Int)]
recursiveFun Seq Int
nu Seq Int
hw])
                  [Seq Int]
parts
        where
          ellW :: Int
ellW = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
w 
          d :: Int
d = Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
kappa Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int
w Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
ellW Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
          lower :: Seq Int
lower = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Seq Int
mu'' (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
1 Seq Int
kappa Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
0) 
          parts :: [Seq Int]
parts = Int -> Seq Int -> Seq Int -> [Seq Int]
sandwichedPartitions Int
d Seq Int
lower Seq Int
kappa 
          hw :: Seq Int
hw = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.take (Int
ellW Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1) Seq Int
w
    patterns :: [Seq (Seq Int)]
patterns = Seq Int -> Seq Int -> [Seq (Seq Int)]
recursiveFun Seq Int
lambda' Seq Int
weight'
    indices :: Partition
indices = (Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) ((Int -> Int -> Int) -> Partition -> Partition
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Int -> Int -> Int
forall a. C a => a -> a -> a
(+) (Int
1 Int -> Partition -> Partition
forall a. a -> [a] -> [a]
: (Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1) Partition
weight))

skewGelfandTsetlinPatternToTableau :: [Seq Int] -> [(Int, Seq Int)]
skewGelfandTsetlinPatternToTableau :: [Seq Int] -> [(Int, Seq Int)]
skewGelfandTsetlinPatternToTableau [Seq Int]
pattern = 
  if Int
ellLambda Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then []
    else Seq (Int, Seq Int) -> [(Int, Seq Int)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList Seq (Int, Seq Int)
skewTableau
  where
    lambda :: Seq Int
lambda = [Seq Int]
pattern [Seq Int] -> Int -> Seq Int
forall a. HasCallStack => [a] -> Int -> a
!! ([Seq Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Seq Int]
pattern Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
    ellLambda :: Int
ellLambda = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
lambda
    mu :: Seq Int
mu = [Seq Int]
pattern [Seq Int] -> Int -> Seq Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
0
    mu' :: Seq Int
mu' = Seq Int
mu Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< (Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
ellLambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu) Int
0)
    skewPartitionRows :: Seq Int -> Seq Int -> Partition
skewPartitionRows Seq Int
kappa Seq Int
nu = 
      ((Int, Int) -> Partition) -> Seq (Int, Int) -> Partition
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> Int -> Partition) -> (Int, Int) -> Partition
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate) (Seq Int -> Seq Int -> Seq (Int, Int)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq Int
differences Seq Int
indices)
      where
        indices :: Seq Int
indices = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList [Int
0 .. Int
ellLambda]
        differences :: Seq Int
differences = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (-) Seq Int
kappa Seq Int
nu Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
nu) Seq Int
kappa
    startingTableau :: Seq (Seq a)
startingTableau = Int -> Seq a -> Seq (Seq a)
forall a. Int -> a -> Seq a
S.replicate Int
ellLambda Seq a
forall a. Seq a
S.Empty
    growTableau :: Seq (Seq Int) -> (Int, Seq Int, Seq Int) -> Seq (Seq Int)
    growTableau :: Seq (Seq Int) -> (Int, Seq Int, Seq Int) -> Seq (Seq Int)
growTableau Seq (Seq Int)
tableau (Int
j, Seq Int
kappa, Seq Int
nu) =
      (Int -> Seq (Seq Int) -> Seq (Seq Int))
-> Seq (Seq Int) -> Partition -> Seq (Seq Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
DF.foldr ((Seq Int -> Seq Int) -> Int -> Seq (Seq Int) -> Seq (Seq Int)
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' ((Seq Int -> Int -> Seq Int) -> Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
(|>) Int
j)) Seq (Seq Int)
tableau (Seq Int -> Seq Int -> Partition
skewPartitionRows Seq Int
kappa Seq Int
nu)
    skewPartitions :: [(Int, Seq Int, Seq Int)]
skewPartitions = Partition -> [Seq Int] -> [Seq Int] -> [(Int, Seq Int, Seq Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1 ..] ([Seq Int] -> [Seq Int]
forall a. [a] -> [a]
drop1 [Seq Int]
pattern) [Seq Int]
pattern
    skewTableau :: Seq (Int, Seq Int)
skewTableau = 
      Seq Int -> Seq (Seq Int) -> Seq (Int, Seq Int)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq Int
mu' ((Seq (Seq Int) -> (Int, Seq Int, Seq Int) -> Seq (Seq Int))
-> Seq (Seq Int) -> [(Int, Seq Int, Seq Int)] -> Seq (Seq Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
DF.foldl' Seq (Seq Int) -> (Int, Seq Int, Seq Int) -> Seq (Seq Int)
growTableau Seq (Seq Int)
forall {a}. Seq (Seq a)
startingTableau [(Int, Seq Int, Seq Int)]
skewPartitions)

_skewTableauxWithGivenShapeAndWeight :: 
  Partition -> Partition -> [Int] -> [[(Int, Seq Int)]]
_skewTableauxWithGivenShapeAndWeight :: Partition -> Partition -> Partition -> [[(Int, Seq Int)]]
_skewTableauxWithGivenShapeAndWeight Partition
lambda Partition
mu Partition
weight = 
  ([Seq Int] -> [(Int, Seq Int)])
-> [[Seq Int]] -> [[(Int, Seq Int)]]
forall a b. (a -> b) -> [a] -> [b]
map [Seq Int] -> [(Int, Seq Int)]
skewGelfandTsetlinPatternToTableau 
      (Partition -> Partition -> Partition -> [[Seq Int]]
_skewGelfandTsetlinPatterns Partition
lambda Partition
mu Partition
weight) 

_skewKostkaFoulkesPolynomial :: 
  (Eq a, AlgRing.C a) => Partition -> Partition -> Partition -> Spray a
_skewKostkaFoulkesPolynomial :: forall a.
(Eq a, C a) =>
Partition -> Partition -> Partition -> Spray a
_skewKostkaFoulkesPolynomial Partition
lambda Partition
mu Partition
nu = 
  if Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Partition -> Int
forall a. C a => [a] -> a
sum Partition
mu Int -> Int -> Int
forall a. C a => a -> a -> a
+ Partition -> Int
forall a. C a => [a] -> a
sum Partition
nu
    then [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
sprays
    else Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  where
    tableaux :: [[(Int, Seq Int)]]
tableaux = Partition -> Partition -> Partition -> [[(Int, Seq Int)]]
_skewTableauxWithGivenShapeAndWeight Partition
lambda Partition
mu Partition
nu
    word :: [(a, Seq a)] -> Seq a
word [(a, Seq a)]
skewT = [Seq a] -> Seq a
forall a. Monoid a => [a] -> a
mconcat ((Seq a -> Seq a) -> [Seq a] -> [Seq a]
forall a b. (a -> b) -> [a] -> [b]
map Seq a -> Seq a
forall a. Seq a -> Seq a
S.reverse (([a], [Seq a]) -> [Seq a]
forall a b. (a, b) -> b
snd ([(a, Seq a)] -> ([a], [Seq a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, Seq a)]
skewT))) 
    mm :: Int -> Spray a
mm = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1 
    sprays :: [Spray a]
sprays = ([(Int, Seq Int)] -> Spray a) -> [[(Int, Seq Int)]] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Spray a
mm (Int -> Spray a)
-> ([(Int, Seq Int)] -> Int) -> [(Int, Seq Int)] -> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Int
charge (Seq Int -> Int)
-> ([(Int, Seq Int)] -> Seq Int) -> [(Int, Seq Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Seq Int)] -> Seq Int
forall {a} {a}. [(a, Seq a)] -> Seq a
word) [[(Int, Seq Int)]]
tableaux

gtPatternDiagonals :: GT -> (Int, [Partition])
gtPatternDiagonals :: [Partition] -> (Int, [Partition])
gtPatternDiagonals [Partition]
pattern = (Int
corner, [Int -> Partition
diagonal Int
j | Int
j <- [Int
1 .. Int
l]])
  where
    l :: Int
l = [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
pattern Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1
    corner :: Int
corner = [Partition]
pattern [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! Int
l Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
0
    diagonal :: Int -> Partition
diagonal Int
j = 
      Partition -> Partition
dropTailingZeros
        [[Partition]
pattern [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! Int
r Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
c | (Int
r, Int
c) <- Partition -> Partition -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
j .. Int
l] [Int
0 .. Int
j]]

gtPatternToTableau :: GT -> [Seq Int]
gtPatternToTableau :: [Partition] -> [Seq Int]
gtPatternToTableau [Partition]
pattern = 
  if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 
    then Seq (Seq Int) -> [Seq Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq (Seq Int) -> [Seq Int]) -> Seq (Seq Int) -> [Seq Int]
forall a b. (a -> b) -> a -> b
$ Int -> Seq (Seq Int) -> Seq (Seq Int)
go Int
0 Seq (Seq Int)
forall {a}. Seq (Seq a)
startingTableau
    else [Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate Int
corner Int
1]
  where
    (Int
corner, [Partition]
diagonals) = [Partition] -> (Int, [Partition])
gtPatternDiagonals [Partition]
pattern
    diagonals' :: [Partition]
diagonals' = [Int
corner] Partition -> [Partition] -> [Partition]
forall a. a -> [a] -> [a]
: [Partition]
diagonals
    l :: Int
l = [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
diagonals Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1
    lambda :: Partition
lambda = [Partition]
diagonals [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! Int
l
    m :: Int
m = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda
    startingTableau :: Seq (Seq a)
startingTableau = Int -> Seq a -> Seq (Seq a)
forall a. Int -> a -> Seq a
S.replicate Int
m Seq a
forall a. Seq a
S.Empty
    skewPartitions :: [(Partition, Partition)]
skewPartitions = [Partition] -> [Partition] -> [(Partition, Partition)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
diagonals [Partition]
diagonals'
    skewPartitionRows :: (Partition, Partition) -> [b]
skewPartitionRows (Partition
kappa, Partition
nu) = 
      ((b, Int) -> [b]) -> [(b, Int)] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(b
i, Int
d) -> Int -> b -> [b]
forall a. Int -> a -> [a]
replicate Int
d b
i) ([b] -> Partition -> [(b, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b
0 ..] Partition
differences)
      where
        differences :: Partition
differences = (Int -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) Partition
kappa Partition
nu Partition -> Partition -> Partition
forall a. [a] -> [a] -> [a]
++ Int -> Partition -> Partition
forall a. Int -> [a] -> [a]
drop (Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu) Partition
kappa
    go :: Int -> Seq (Seq Int) -> Seq (Seq Int)
go Int
i Seq (Seq Int)
tableau
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
          Int -> Seq (Seq Int) -> Seq (Seq Int)
go Int
1 ((Seq Int -> Seq Int) -> Int -> Seq (Seq Int) -> Seq (Seq Int)
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' ((Seq Int -> Seq Int -> Seq Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
(><) (Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate Int
corner Int
1)) Int
0 Seq (Seq Int)
tableau)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
2 = 
          Seq (Seq Int)
tableau
      | Bool
otherwise = 
          Int -> Seq (Seq Int) -> Seq (Seq Int)
go (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) (Int -> Seq (Seq Int) -> (Partition, Partition) -> Seq (Seq Int)
growTableau (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) Seq (Seq Int)
tableau ([(Partition, Partition)]
skewPartitions [(Partition, Partition)] -> Int -> (Partition, Partition)
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)))
    growTableau :: 
      Int -> Seq (Seq Int) -> (Partition, Partition) -> Seq (Seq Int)
    growTableau :: Int -> Seq (Seq Int) -> (Partition, Partition) -> Seq (Seq Int)
growTableau Int
j Seq (Seq Int)
tableau (Partition, Partition)
skewPart =
      (Int -> Seq (Seq Int) -> Seq (Seq Int))
-> Seq (Seq Int) -> Partition -> Seq (Seq Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
DF.foldr ((Seq Int -> Seq Int) -> Int -> Seq (Seq Int) -> Seq (Seq Int)
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' ((Seq Int -> Int -> Seq Int) -> Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
(|>) Int
j)) Seq (Seq Int)
tableau ((Partition, Partition) -> Partition
forall {b}. (Num b, Enum b) => (Partition, Partition) -> [b]
skewPartitionRows (Partition, Partition)
skewPart)

_semiStandardTableauxWithGivenShapeAndWeight :: 
  Partition -> [Int] -> [[Seq Int]]
_semiStandardTableauxWithGivenShapeAndWeight :: Partition -> Partition -> [[Seq Int]]
_semiStandardTableauxWithGivenShapeAndWeight Partition
lambda Partition
weight =
  ([Partition] -> [Seq Int]) -> [[Partition]] -> [[Seq Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Partition] -> [Seq Int]
gtPatternToTableau (Partition -> Partition -> [[Partition]]
kostkaGelfandTsetlinPatterns' Partition
lambda' Partition
weight)
  where
    lambda' :: Partition
lambda' = Partition -> Partition
toPartitionUnsafe Partition
lambda

-- length lambda = length as = length bs; as <= bs; last bs >= length lambda

flaggedSemiStandardYoungTableaux :: Partition -> [Int] -> [Int] -> [[[Int]]] 
flaggedSemiStandardYoungTableaux :: Partition -> Partition -> Partition -> [[Partition]]
flaggedSemiStandardYoungTableaux Partition
lambda Partition
as Partition
bs = 
  Partition -> Partition -> Int -> [[Partition]]
worker (Int -> Partition
forall a. a -> [a]
repeat Int
0) Partition
lambda Int
0
    where
      worker :: Partition -> Partition -> Int -> [[Partition]]
worker Partition
_ [] Int
_ = [[]] 
      worker Partition
prevRow (Int
s:Partition
ss) Int
i
        = [ (Partition
rPartition -> [Partition] -> [Partition]
forall a. a -> [a] -> [a]
:[Partition]
rs) 
            | Partition
r <- Int -> Int -> Int -> Partition -> [Partition]
row (Partition
bs Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) Int
s (Partition
as Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) Partition
prevRow
            , [Partition]
rs <- Partition -> Partition -> Int -> [[Partition]]
worker ((Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) Partition
r) Partition
ss (Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1) ]
      -- weekly increasing lists of length @len@, pointwise at least @xs@, 

      -- maximum value @n@, minimum value @prev@.

      row :: Int -> Int -> Int -> [Int] -> [[Int]]
      row :: Int -> Int -> Int -> Partition -> [Partition]
row Int
n Int
len Int
prev Partition
xxs = 
        if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
          then [[]] 
          else [ (Int
jInt -> Partition -> Partition
forall a. a -> [a] -> [a]
:Partition
js) | Int
j <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
prev .. Int
n], Partition
js <- Int -> Int -> Int -> Partition -> [Partition]
row Int
n (Int
lenInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int
j Partition
xs ]
          where
            (Int
x, Partition
xs) = Maybe (Int, Partition) -> (Int, Partition)
forall a. HasCallStack => Maybe a -> a
fromJust (Partition -> Maybe (Int, Partition)
forall a. [a] -> Maybe (a, [a])
uncons Partition
xxs)

tableauWeight :: [[Int]] -> [Int]
tableauWeight :: [Partition] -> Partition
tableauWeight [Partition]
tableau = [Int -> Int
count Int
i | Int
i <- [Int
1 .. Int
m]]
  where
    x :: Partition
x = [Partition] -> Partition
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Partition]
tableau
    m :: Int
m = Partition -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Partition
x
    count :: Int -> Int
count Int
i = Partition -> Int
forall a. C a => [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
i) | Int
k <- Partition
x]

flaggedSkewTableaux :: 
  Partition -> Partition -> [Int] -> [Int] -> [[(Int,[Int])]]
flaggedSkewTableaux :: Partition
-> Partition -> Partition -> Partition -> [[(Int, Partition)]]
flaggedSkewTableaux Partition
lambda Partition
mu Partition
as Partition
bs = Partition
-> Partition
-> Partition
-> Partition
-> Int
-> [[(Int, Partition)]]
worker Partition
uus Partition
vvs Partition
dds (Int -> Partition
forall a. a -> [a]
repeat Int
1) Int
0
  where
    uus :: Partition
uus = Partition
mu Partition -> Partition -> Partition
forall a. [a] -> [a] -> [a]
++ (Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate (Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
mu) Int
0)
    vvs :: Partition
vvs = (Int -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) Partition
lambda Partition
uus
    dds :: Partition
dds = Partition -> Partition
_diffSequence Partition
uus
    _diffSequence :: [Int] -> [Int]
    _diffSequence :: Partition -> Partition
_diffSequence = Partition -> Partition
forall {a}. C a => [a] -> [a]
go where
      go :: [a] -> [a]
go (a
x:ys :: [a]
ys@(a
y:[a]
_)) = (a
xa -> a -> a
forall a. C a => a -> a -> a
-a
y) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
ys 
      go [a
x] = [a
x]
      go []  = []
    -- | @worker inner outerMinusInner innerdiffs lowerbound

    worker :: [Int] -> [Int] -> [Int] -> [Int] -> Int -> [[(Int,[Int])]]
    worker :: Partition
-> Partition
-> Partition
-> Partition
-> Int
-> [[(Int, Partition)]]
worker (Int
u:Partition
us) (Int
v:Partition
vs) (Int
d:Partition
ds) Partition
lb Int
i 
      = [ (Int
u, Partition
this)(Int, Partition) -> [(Int, Partition)] -> [(Int, Partition)]
forall a. a -> [a] -> [a]
:[(Int, Partition)]
rest 
          | Partition
this <- Int -> Int -> Int -> Partition -> [Partition]
row (Partition
bs Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) Int
v (Partition
as Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) Partition
lb 
          , let lb' :: Partition
lb' = (Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate Int
d Int
1 Partition -> Partition -> Partition
forall a. [a] -> [a] -> [a]
++ (Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) Partition
this) 
          , [(Int, Partition)]
rest <- Partition
-> Partition
-> Partition
-> Partition
-> Int
-> [[(Int, Partition)]]
worker Partition
us Partition
vs Partition
ds Partition
lb' (Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1)] 
    worker []     Partition
_      Partition
_      Partition
_  Int
_ = [ [] ]
    worker (Int
_:Partition
_)  []     Partition
_      Partition
_  Int
_ = [ [] ]
    worker (Int
_:Partition
_)  (Int
_:Partition
_)  []     Partition
_  Int
_ = [ [] ]
    -- weekly increasing lists of length @len@, pointwise at least @xs@, 

    -- maximum value @n@, minimum value @prev@.

    row :: Int -> Int -> Int -> [Int] -> [[Int]]
    row :: Int -> Int -> Int -> Partition -> [Partition]
row Int
n Int
len Int
prev Partition
xxs = 
      if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
        then [[]] 
        else [ (Int
jInt -> Partition -> Partition
forall a. a -> [a] -> [a]
:Partition
js) | Int
j <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
prev .. Int
n], Partition
js <- Int -> Int -> Int -> Partition -> [Partition]
row Int
n (Int
lenInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int
j Partition
xs ]
        where
          (Int
x, Partition
xs) = Maybe (Int, Partition) -> (Int, Partition)
forall a. HasCallStack => Maybe a -> a
fromJust (Partition -> Maybe (Int, Partition)
forall a. [a] -> Maybe (a, [a])
uncons Partition
xxs)

skewTableauWeight :: [(Int, [Int])] -> [Int]
skewTableauWeight :: [(Int, Partition)] -> Partition
skewTableauWeight [(Int, Partition)]
skewT = [Int -> Int
count Int
i | Int
i <- [Int
1 .. Int
m]]
  where
    (Partition
_, [Partition]
entries) = [(Int, Partition)] -> (Partition, [Partition])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Int, Partition)]
skewT
    x :: Partition
x = [Partition] -> Partition
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Partition]
entries
    m :: Int
m = Partition -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Partition
x
    count :: Int -> Int
count Int
i = Partition -> Int
forall a. C a => [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
i) | Int
k <- Partition
x]

isIncreasing :: [Int] -> Bool
isIncreasing :: Partition -> Bool
isIncreasing Partition
s = 
  [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. Ord a => a -> a -> Bool
(<=) Partition
s (Partition -> Partition
forall a. [a] -> [a]
drop1 Partition
s))

_paths :: Int -> Seq Int -> Seq Int -> [(Partition, [[(Seq Int, Seq Int)]])]
_paths :: Int -> Seq Int -> Seq Int -> [(Partition, [[PartitionsPair]])]
_paths Int
n Seq Int
lambda Seq Int
mu =
  ((Partition, [[PartitionsPair]]) -> Bool)
-> [(Partition, [[PartitionsPair]])]
-> [(Partition, [[PartitionsPair]])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool
not (Bool -> Bool)
-> ([[PartitionsPair]] -> Bool) -> [[PartitionsPair]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PartitionsPair]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[PartitionsPair]] -> Bool)
-> ((Partition, [[PartitionsPair]]) -> [[PartitionsPair]])
-> (Partition, [[PartitionsPair]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition, [[PartitionsPair]]) -> [[PartitionsPair]]
forall a b. (a, b) -> b
snd) ((Partition -> (Partition, [[PartitionsPair]]))
-> [Partition] -> [(Partition, [[PartitionsPair]])]
forall a b. (a -> b) -> [a] -> [b]
map 
    (\Partition
nu -> let nu' :: Partition
nu' = Partition -> Partition
fromPartition Partition
nu 
                nu'' :: Partition
nu'' = Partition
nu' Partition -> Partition -> Partition
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu') Int
0
            in
      (
        Partition
nu''
      , ([Seq Int] -> [PartitionsPair])
-> [[Seq Int]] -> [[PartitionsPair]]
forall a b. (a -> b) -> [a] -> [b]
map [Seq Int] -> [PartitionsPair]
forall {b}. [b] -> [(b, b)]
pairing (Partition -> Partition -> Partition -> [[Seq Int]]
_skewGelfandTsetlinPatterns Partition
lambda' Partition
mu' Partition
nu'')
      )
    ) 
    [Partition]
nus)
  where
    mu' :: Partition
mu' = Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList Seq Int
mu
    pairing :: [b] -> [(b, b)]
pairing [b]
lambdas = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([b] -> [b]
forall a. [a] -> [a]
drop1 [b]
lambdas) [b]
lambdas
    lambda' :: Partition
lambda' = Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList Seq Int
lambda
    nus :: [Partition]
nus = 
      (Partition -> Bool) -> [Partition] -> [Partition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Int -> Bool) -> (Partition -> Int) -> Partition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> Int
partitionWidth) ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ 
        Partition -> [Partition]
dominatedPartitions 
          (Partition -> Partition
toPartitionUnsafe 
            (Int -> Partition -> Partition
lastSubPartition (Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
lambda Int -> Int -> Int
forall a. C a => a -> a -> a
- Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
mu) Partition
lambda'))

psi_lambda_mu :: (Eq a, AlgRing.C a) 
  => Seq Int -> Seq Int -> Spray a
psi_lambda_mu :: forall a. (Eq a, C a) => Seq Int -> Seq Int -> Spray a
psi_lambda_mu Seq Int
lambda Seq Int
mu = if Seq Int -> Bool
forall a. Seq a -> Bool
S.null Seq Int
lambda
  then Spray a
forall a. C a => Spray a
unitSpray
  else [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Spray a]
sprays
  where
    range :: Partition
range = [Int
1 .. Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0]
    pair :: Int -> (Int, Int)
pair Int
j = (
        Int
1 Int -> Int -> Int
forall a. C a => a -> a -> a
+ Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum ((Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
k -> Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j)) Seq Int
lambda)
      , Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum ((Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
k -> Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j)) Seq Int
mu)
      )
    pairs :: [(Int, Int)]
pairs = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
l, Int
m) -> Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m) ((Int -> (Int, Int)) -> Partition -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, Int)
pair Partition
range)
    t :: Int -> Spray a
t = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1
    sprays :: [Spray a]
sprays = ((Int, Int) -> Spray a) -> [(Int, Int)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Int
m) -> a
BaseRing (Spray a)
forall a. C a => a
AlgRing.one BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> Spray a -> Spray a
forall a. C a => a -> a
AlgAdd.negate (Int -> Spray a
t Int
m)) [(Int, Int)]
pairs

phi_lambda_mu :: (Eq a, AlgRing.C a) 
  => Seq Int -> Seq Int -> Spray a
phi_lambda_mu :: forall a. (Eq a, C a) => Seq Int -> Seq Int -> Spray a
phi_lambda_mu Seq Int
lambda Seq Int
mu = if Seq Int -> Bool
forall a. Seq a -> Bool
S.null Seq Int
lambda
  then Spray a
forall a. C a => Spray a
unitSpray
  else [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Spray a]
sprays
  where
    range :: Partition
range = [Int
1 .. Seq Int
lambda Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` Int
0]
    pair :: Int -> (Int, Int)
pair Int
j = (
        Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum ((Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
k -> Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j)) Seq Int
lambda)
      , Int
1 Int -> Int -> Int
forall a. C a => a -> a -> a
+ Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum ((Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
k -> Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j)) Seq Int
mu)
      )
    pairs :: [(Int, Int)]
pairs = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
l, Int
m) -> Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m) ((Int -> (Int, Int)) -> Partition -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, Int)
pair Partition
range)
    t :: Int -> Spray a
t = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1
    sprays :: [Spray a]
sprays = ((Int, Int) -> Spray a) -> [(Int, Int)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
m, Int
_) -> a
BaseRing (Spray a)
forall a. C a => a
AlgRing.one BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> Spray a -> Spray a
forall a. C a => a -> a
AlgAdd.negate (Int -> Spray a
t Int
m)) [(Int, Int)]
pairs

_skewHallLittlewood :: (Eq a, AlgRing.C a) 
  => (Seq Int -> Seq Int -> Spray a) -> Int -> Seq Int -> Seq Int 
      -> SimpleParametricSpray a
_skewHallLittlewood :: forall a.
(Eq a, C a) =>
(Seq Int -> Seq Int -> Spray a)
-> Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
_skewHallLittlewood Seq Int -> Seq Int -> Spray a
f Int
n Seq Int
lambda Seq Int
mu = 
  [Spray (Spray a)] -> Spray (Spray a)
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays (((Partition, [[PartitionsPair]]) -> [Spray (Spray a)])
-> [(Partition, [[PartitionsPair]])] -> [Spray (Spray a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Partition, [[PartitionsPair]]) -> [Spray (Spray a)]
sprays [(Partition, [[PartitionsPair]])]
paths)
  where
    paths :: [(Partition, [[PartitionsPair]])]
paths = Int -> Seq Int -> Seq Int -> [(Partition, [[PartitionsPair]])]
_paths Int
n Seq Int
lambda Seq Int
mu
    allPairs :: [PartitionsPair]
allPairs = [PartitionsPair] -> [PartitionsPair]
forall a. Eq a => [a] -> [a]
nub ([[PartitionsPair]] -> [PartitionsPair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[PartitionsPair]]] -> [[PartitionsPair]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Partition], [[[PartitionsPair]]]) -> [[[PartitionsPair]]]
forall a b. (a, b) -> b
snd ([(Partition, [[PartitionsPair]])]
-> ([Partition], [[[PartitionsPair]]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Partition, [[PartitionsPair]])]
paths))))
    psis :: HashMap PartitionsPair (Spray a)
psis = 
      [(PartitionsPair, Spray a)] -> HashMap PartitionsPair (Spray a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList 
        ((PartitionsPair -> (PartitionsPair, Spray a))
-> [PartitionsPair] -> [(PartitionsPair, Spray a)]
forall a b. (a -> b) -> [a] -> [b]
map (\PartitionsPair
pair -> (PartitionsPair
pair, (Seq Int -> Seq Int -> Spray a) -> PartitionsPair -> Spray a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq Int -> Seq Int -> Spray a
f PartitionsPair
pair)) [PartitionsPair]
allPairs)
    dropTrailingZeros :: Seq Int -> Seq Int
dropTrailingZeros = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.dropWhileR (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    sprays :: (Partition, [[PartitionsPair]]) -> [Spray (Spray a)]
sprays (Partition
nu, [[PartitionsPair]]
listsOfPairs) =
      let  
        sprays' :: [Spray a]
sprays' = 
          [[Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [HashMap PartitionsPair (Spray a)
psis HashMap PartitionsPair (Spray a) -> PartitionsPair -> Spray a
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PartitionsPair
pair | PartitionsPair
pair <- [PartitionsPair]
pairs] 
            | [PartitionsPair]
pairs <- [[PartitionsPair]]
listsOfPairs]
        listOfPowers :: [Powers]
listOfPowers = 
          [Seq Int -> Int -> Powers
Powers Seq Int
expnts (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
expnts) | 
            Partition
compo <- Partition -> [Partition]
forall a. (Eq a, Ord a) => [a] -> [[a]]
permuteMultiset Partition
nu, 
            let expnts :: Seq Int
expnts = Seq Int -> Seq Int
dropTrailingZeros (Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
compo)]
        in
        [
          Powers -> Spray a -> Spray (Spray a)
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Powers
powers Spray a
spray
          | Spray a
spray <- [Spray a]
sprays', Powers
powers <- [Powers]
listOfPowers
        ]

skewHallLittlewoodP :: (Eq a, AlgRing.C a) 
  => Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
skewHallLittlewoodP :: forall a.
(Eq a, C a) =>
Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
skewHallLittlewoodP = (Seq Int -> Seq Int -> Spray a)
-> Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
forall a.
(Eq a, C a) =>
(Seq Int -> Seq Int -> Spray a)
-> Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
_skewHallLittlewood Seq Int -> Seq Int -> Spray a
forall a. (Eq a, C a) => Seq Int -> Seq Int -> Spray a
psi_lambda_mu

skewHallLittlewoodQ :: (Eq a, AlgRing.C a) 
  => Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
skewHallLittlewoodQ :: forall a.
(Eq a, C a) =>
Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
skewHallLittlewoodQ = (Seq Int -> Seq Int -> Spray a)
-> Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
forall a.
(Eq a, C a) =>
(Seq Int -> Seq Int -> Spray a)
-> Int -> Seq Int -> Seq Int -> SimpleParametricSpray a
_skewHallLittlewood Seq Int -> Seq Int -> Spray a
forall a. (Eq a, C a) => Seq Int -> Seq Int -> Spray a
phi_lambda_mu

charge :: Seq Int -> Int
charge :: Seq Int -> Int
charge Seq Int
w = if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Int
0 else Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
DF.sum Seq Int
indices' Int -> Int -> Int
forall a. C a => a -> a -> a
+ Seq Int -> Int
charge Seq Int
w'
  where
    l :: Int
l = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
w
    n :: Int
n = Seq Int -> Int
forall a. Ord a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
DF.maximum Seq Int
w
    (Seq Int
positions', Seq Int
indices') = 
      Int -> Seq Int -> Seq Int -> PartitionsPair
go Int
1 (Int -> Seq Int
forall a. a -> Seq a
S.singleton (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Seq Int -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
S.elemIndexL Int
1 Seq Int
w)) (Int -> Seq Int
forall a. a -> Seq a
S.singleton Int
0)
    w' :: Seq Int
w' = (Int -> Seq Int -> Seq Int) -> Seq Int -> Seq Int -> Seq Int
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
DF.foldr Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.deleteAt Seq Int
w (Seq Int -> Seq Int
forall a. Ord a => Seq a -> Seq a
S.sort Seq Int
positions')
    go :: Int -> Seq Int -> Seq Int -> (Seq Int, Seq Int)
    go :: Int -> Seq Int -> Seq Int -> PartitionsPair
go Int
r Seq Int
positions Seq Int
indices 
      | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n    = (Seq Int
positions, Seq Int
indices)
      | Bool
otherwise = Int -> Seq Int -> Seq Int -> PartitionsPair
go (Int
rInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) (Seq Int
positions Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
pos') (Seq Int
indices Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
index')
        where
          pos :: Int
pos = Seq Int
positions Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
rInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
          index :: Int
index = Seq Int
indices Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`S.index` (Int
rInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
          v :: Seq Int
v = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop (Int
posInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) Seq Int
w
          rindex :: Maybe Int
rindex = Int -> Seq Int -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
S.elemIndexL (Int
rInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) Seq Int
v
          (Int
pos', Int
index') = 
            if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
rindex
              then (Int
1 Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
pos Int -> Int -> Int
forall a. C a => a -> a -> a
+ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
rindex, Int
index)
              else (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Int -> Seq Int -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
S.elemIndexL (Int
rInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) Seq Int
w), Int
index Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1)

_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 = 
  if Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Partition -> Int
forall a. C a => [a] -> a
sum Partition
mu 
    then [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays [Spray a]
sprays
    else Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  where
    tableaux :: [[Seq Int]]
tableaux = Partition -> Partition -> [[Seq Int]]
_semiStandardTableauxWithGivenShapeAndWeight Partition
lambda Partition
mu
    mm :: Int -> Spray a
mm = Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1 
    sprays :: [Spray a]
sprays =
      ([Seq Int] -> Spray a) -> [[Seq Int]] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Spray a
mm (Int -> Spray a) -> ([Seq Int] -> Int) -> [Seq Int] -> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Int
charge (Seq Int -> Int) -> ([Seq Int] -> Seq Int) -> [Seq Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Seq Int] -> Seq Int
forall a. Monoid a => [a] -> a
mconcat ([Seq Int] -> Seq Int)
-> ([Seq Int] -> [Seq Int]) -> [Seq Int] -> Seq Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Seq Int -> Seq Int
forall a. Seq a -> Seq a
S.reverse))) [[Seq Int]]
tableaux 

b_lambda :: (Eq a, AlgRing.C a) => Partition -> Spray a
b_lambda :: forall a. (Eq a, C a) => Partition -> Spray a
b_lambda Partition
lambda = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Spray a]
sprays
  where
    table :: Partition
table = [Partition -> Int
forall a. C a => [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 -> Partition
forall a. Eq a => [a] -> [a]
nub Partition
lambda]
    sprays :: [Spray a]
sprays = (Int -> Spray a) -> Partition -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Spray a
forall {a}. (Eq a, C a) => Int -> Spray a
phi Partition
table
      where
        phi :: Int -> Spray a
phi Int
r = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays 
                [a
BaseRing (Spray a)
forall a. C a => a
AlgRing.one BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> Spray a -> Spray a
forall a. C a => a -> a
AlgAdd.negate (Int -> Int -> Spray a
forall a. C a => Int -> Int -> Spray a
lone' Int
1 Int
i) | Int
i <- [Int
1 .. Int
r]]

_transitionMatrixHallLittlewoodSchur :: 
  (Eq a, AlgRing.C a) => Char -> Int -> Map Partition (Map Partition (Spray a))
_transitionMatrixHallLittlewoodSchur :: forall a.
(Eq a, C a) =>
Char -> Int -> Map Partition (Map Partition (Spray a))
_transitionMatrixHallLittlewoodSchur Char
which Int
weight = 
  [(Partition, Map Partition (Spray a))]
-> Map Partition (Map Partition (Spray a))
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([(Partition, Map Partition (Spray a))]
 -> Map Partition (Map Partition (Spray a)))
-> [(Partition, Map Partition (Spray a))]
-> Map Partition (Map Partition (Spray a))
forall a b. (a -> b) -> a -> b
$ if Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'P' 
    then 
      [Partition]
-> [Map Partition (Spray a)]
-> [(Partition, Map Partition (Spray a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas [Int -> Map Partition (Spray a)
maps Int
i | Int
i <- Partition
rg]
    else 
      [Partition]
-> [Map Partition (Spray a)]
-> [(Partition, Map Partition (Spray a))]
forall a b. [a] -> [b] -> [(a, b)]
zip 
        [Partition]
lambdas 
        [(Partition -> Spray a -> Spray a)
-> Map Partition (Spray a) -> Map Partition (Spray a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
lambda Spray a
c -> Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
b_lambda Partition
lambda Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
c) (Int -> Map Partition (Spray a)
maps Int
i) | Int
i <- Partition
rg]
  where
    lambdas :: [Partition]
lambdas = [Partition] -> [Partition]
forall a. [a] -> [a]
reverse ((Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
fromPartition (Int -> [Partition]
partitions Int
weight))
    rg :: Partition
rg = [Int
1 .. [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
lambdas]
    kfs :: [[Spray a]]
kfs = (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]
f [Partition]
lambdas
    f :: Partition -> [Spray a]
f Partition
kappa = 
      (Partition -> Spray a) -> [Partition] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Partition
mu -> Partition -> Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Partition -> Spray a
_kostkaFoulkesPolynomial Partition
kappa Partition
mu)
          [Partition]
lambdas 
    matrix :: Matrix (Spray a)
matrix = Matrix (Spray a) -> Matrix (Spray a)
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseUnitTriangularMatrix ([[Spray a]] -> Matrix (Spray a)
forall a. [[a]] -> Matrix a
fromLists [[Spray a]]
kfs)
    maps :: Int -> Map Partition (Spray a)
maps Int
i = (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) 
          ([(Partition, Spray a)] -> Map Partition (Spray a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition] -> [Spray a] -> [(Partition, Spray a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas (Vector (Spray a) -> [Spray a]
forall a. Vector a -> [a]
V.toList (Int -> Matrix (Spray a) -> Vector (Spray a)
forall a. Int -> Matrix a -> Vector a
getRow Int
i Matrix (Spray a)
matrix))))

_hallLittlewoodPolynomialsInSchurBasis :: 
  (Eq a, AlgRing.C a) => Char -> Partition -> Map Partition (Spray a)
_hallLittlewoodPolynomialsInSchurBasis :: forall a.
(Eq a, C a) =>
Char -> Partition -> Map Partition (Spray a)
_hallLittlewoodPolynomialsInSchurBasis Char
which Partition
lambda = 
  if Char
which Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'P'
    then Map Partition (Spray a)
coeffs
    else (Spray a -> Spray a)
-> Map Partition (Spray a) -> Map Partition (Spray a)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
(^*^) (Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
b_lambda Partition
lambda)) Map Partition (Spray a)
coeffs
  where
    weight :: Int
weight = Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda
    lambdas :: [Partition]
lambdas = 
      [Partition] -> [Partition]
forall a. [a] -> [a]
reverse ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ (Partition -> Bool) -> [Partition] -> [Partition]
forall a. (a -> Bool) -> [a] -> [a]
filter (Partition -> Partition -> Bool
forall a. Ord a => a -> a -> Bool
<= Partition
lambda) ((Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
fromPartition (Int -> [Partition]
partitions Int
weight))
    kfs :: [[Spray a]]
kfs = (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]
f [Partition]
lambdas
    f :: Partition -> [Spray a]
f Partition
kappa = 
      (Partition -> Spray a) -> [Partition] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Partition
mu -> Partition -> Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Partition -> Spray a
_kostkaFoulkesPolynomial Partition
kappa Partition
mu) 
          [Partition]
lambdas -- (dominatedPartitions kappa)

    matrix :: Matrix (Spray a)
matrix = Matrix (Spray a) -> Matrix (Spray a)
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseUnitTriangularMatrix ([[Spray a]] -> Matrix (Spray a)
forall a. [[a]] -> Matrix a
fromLists [[Spray a]]
kfs)
    coeffs :: Map Partition (Spray a)
coeffs = (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) 
          ([(Partition, Spray a)] -> Map Partition (Spray a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition] -> [Spray a] -> [(Partition, Spray a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas (Vector (Spray a) -> [Spray a]
forall a. Vector a -> [a]
V.toList (Int -> Matrix (Spray a) -> Vector (Spray a)
forall a. Int -> Matrix a -> Vector a
getRow Int
1 Matrix (Spray a)
matrix))))

-- _hallLittlewoodPpolynomialInMSPbasis :: 

--   (Eq a, AlgRing.C a) => Partition -> Map Partition (Spray a)

-- _hallLittlewoodPpolynomialInMSPbasis lambda = 

--   DM.unionsWith (^+^) msCombos

--   where

--     schurCombo = _hallLittlewoodPolynomialsInSchurBasis 'P' lambda

--     schurAssocs = DM.assocs schurCombo

--     msCombos = 

--       map 

--         (\(kappa, spray) -> 

--           DM.mapKeys fromPartition 

--             (DM.map (\kn -> kn .^ spray) 

--               (kostkaNumbersWithGivenLambda (toPartitionUnsafe kappa))))

--         schurAssocs


-- | monomial symmetric polynomials in Schur polynomials basis

msPolynomialsInSchurBasis :: 
  Int -> Int -> Map Partition (Map Partition Rational)
msPolynomialsInSchurBasis :: Int -> Int -> Map Partition (Map Partition Rational)
msPolynomialsInSchurBasis Int
n Int
weight = 
   Int
-> Int
-> Rational
-> Char
-> Map Partition (Map Partition Rational)
forall a.
(Eq a, C a) =>
Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_inverseKostkaMatrix Int
n Int
weight Rational
1 Char
'P'

-- | monomial symmetric polynomial in Hall-Littlewood P-polynomials basis

_msPolynomialInHLPbasis :: 
  Int -> Partition -> Map Partition (Spray Rational)
_msPolynomialInHLPbasis :: Int -> Partition -> Map Partition (Spray Rational)
_msPolynomialInHLPbasis Int
n Partition
lambda = 
  (Spray Rational -> Bool)
-> Map Partition (Spray Rational) -> Map Partition (Spray Rational)
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (Bool -> Bool
not (Bool -> Bool)
-> (Spray Rational -> Bool) -> Spray Rational -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spray Rational -> Bool
forall a. Spray a -> Bool
isZeroSpray) ((Spray Rational -> Spray Rational -> Spray Rational)
-> [Map Partition (Spray Rational)]
-> Map Partition (Spray Rational)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
DM.unionsWith Spray Rational -> Spray Rational -> Spray Rational
forall b. (FunctionLike b, C b) => b -> b -> b
(^+^) [Map Partition (Spray Rational)]
hlpCombos)
  where
    weight :: Int
weight = Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda
    msCombos :: Map Partition (Map Partition Rational)
msCombos = Int -> Int -> Map Partition (Map Partition Rational)
msPolynomialsInSchurBasis Int
n Int
weight
    lambdas :: [Partition]
lambdas = Map Partition (Map Partition Rational) -> [Partition]
forall k a. Map k a -> [k]
DM.keys Map Partition (Map Partition Rational)
msCombos
    hlpCombo :: Partition -> Map Partition (Spray a)
hlpCombo 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) (Map Partition (Spray a) -> Map Partition (Spray a))
-> Map Partition (Spray a) -> Map Partition (Spray a)
forall a b. (a -> b) -> a -> b
$ 
        [(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
kappa -> (Partition
kappa, Partition -> Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Partition -> Spray a
_kostkaFoulkesPolynomial Partition
mu Partition
kappa)) [Partition]
lambdas)
    msAssocs :: [(Partition, Rational)]
msAssocs = Map Partition Rational -> [(Partition, Rational)]
forall k a. Map k a -> [(k, a)]
DM.assocs (Map Partition (Map Partition Rational)
msCombos Map Partition (Map Partition Rational)
-> Partition -> Map Partition Rational
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda)
    hlpCombos :: [Map Partition (Spray Rational)]
hlpCombos =
      ((Partition, Rational) -> Map Partition (Spray Rational))
-> [(Partition, Rational)] -> [Map Partition (Spray Rational)]
forall a b. (a -> b) -> [a] -> [b]
map 
        (\(Partition
mu, Rational
r) ->
          (Spray Rational -> Spray Rational)
-> Map Partition (Spray Rational) -> Map Partition (Spray Rational)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (\Spray Rational
spray -> Rational
BaseRing (Spray Rational)
r BaseRing (Spray Rational) -> Spray Rational -> Spray Rational
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray Rational
spray) (Partition -> Map Partition (Spray Rational)
forall {a}. (Eq a, C a) => Partition -> Map Partition (Spray a)
hlpCombo Partition
mu))
        [(Partition, Rational)]
msAssocs

_e :: AlgRing.C a => MCP.Partition -> a -> a
_e :: forall a. C a => Partition -> a -> a
_e Partition
lambda a
alpha = 
  a
alpha a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Partition -> Int
_n (Partition -> Partition
dualPartition Partition
lambda)) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Partition -> Int
_n Partition
lambda)
  where
    _n :: Partition -> Int
_n Partition
mu = Partition -> Int
forall a. C a => [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
(P.*) [Int
0 .. ] (Partition -> Partition
fromPartition Partition
mu))

_eSymbolic :: (Eq a, AlgRing.C a) => MCP.Partition -> Spray a 
_eSymbolic :: forall a. (Eq a, C a) => Partition -> Spray a
_eSymbolic Partition
lambda = 
  Partition -> Int
_n (Partition -> Partition
dualPartition Partition
lambda) Int -> Spray a -> Spray a
forall a. (C a, Eq a) => Int -> a -> a
.^ Spray a
alpha Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (- Partition -> Int
_n Partition
lambda)
  where
    alpha :: Spray a
alpha = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
1
    _n :: Partition -> Int
_n Partition
mu = Partition -> Int
forall a. C a => [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
(P.*) [Int
0 .. ] (Partition -> Partition
fromPartition Partition
mu))

_kostkaNumbersWithGivenLambda :: 
  forall a. (AlgField.C a) 
  => Int -> Partition -> a -> Char -> Map Partition a
_kostkaNumbersWithGivenLambda :: forall a. C a => Int -> Partition -> a -> Char -> Map Partition a
_kostkaNumbersWithGivenLambda Int
nv Partition
lambda a
alpha Char
which = Int -> Map Partition a
rec ([Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
mus')
  where
    kN1 :: a
kN1 = case Char
which of
      Char
'J' -> a -> a
forall a. C a => a -> a
recip (Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffP Partition
lambda a
alpha)
      Char
'P' -> a
forall a. C a => a
AlgRing.one
      Char
'C' -> Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffC Partition
lambda a
alpha a -> a -> a
forall a. C a => a -> a -> a
/ Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffP Partition
lambda a
alpha
      Char
'Q' -> Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffQ Partition
lambda a
alpha a -> a -> a
forall a. C a => a -> a -> a
/ Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffP Partition
lambda a
alpha
      Char
_   -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"_kostkaNumbersWithGivenLambda: should not happen."
    mu_r_plus :: 
      Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
    mu_r_plus :: Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus Seq Int
mu pair :: (Int, Int)
pair@(Int
i, Int
j) Int
r = 
      (
          Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> Partition) -> Seq Int -> Partition
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Seq a -> Seq a
S.reverse (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Ord a => Seq a -> Seq a
S.sort (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ 
            (Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' (Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.+) Int
r) Int
i ((Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
r) Int
j Seq Int
mu)
        , (Int, Int)
pair
        , Int
r
      )
    mu_r_plus' :: 
      Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
    mu_r_plus' :: Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus' Seq Int
mu pair :: (Int, Int)
pair@(Int
i, Int
j) Int
r = 
      (
          Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> Partition) -> Seq Int -> Partition
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Seq a -> Seq a
S.reverse (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Ord a => Seq a -> Seq a
S.sort (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ 
            Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.deleteAt Int
j ((Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' (Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.+) Int
r) Int
i Seq Int
mu)
        , (Int, Int)
pair
        , Int
r
      )
    lambda' :: Partition
lambda' = Partition -> Partition
toPartitionUnsafe Partition
lambda
    mus' :: [Partition]
mus' = [Partition] -> [Partition]
forall a. [a] -> [a]
reverse ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ 
      (Partition -> Bool) -> [Partition] -> [Partition]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Partition
part -> Partition -> Int
partitionWidth Partition
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nv) (Partition -> [Partition]
dominatedPartitions Partition
lambda')
    _e_lambda_alpha :: a
_e_lambda_alpha = Partition -> a -> a
forall a. C a => Partition -> a -> a
_e Partition
lambda' a
alpha
    rec :: Int -> Map Partition a
    rec :: Int -> Map Partition a
rec Int
n = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      then Partition -> a -> Map Partition a
forall k a. k -> a -> Map k a
DM.singleton Partition
lambda a
kN1
      else Partition -> a -> Map Partition a -> Map Partition a
forall k a. Ord k => k -> a -> Map k a -> Map k a
DM.insert Partition
mu a
kNumber Map Partition a
previous 
      where
        previous :: Map Partition a
previous = Int -> Map Partition a
rec (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
        parts :: [Partition]
parts = Map Partition a -> [Partition]
forall k a. Map k a -> [k]
DM.keys Map Partition a
previous
        mu' :: Partition
mu' = [Partition]
mus' [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
        mu :: Partition
mu = Partition -> Partition
fromPartition Partition
mu'
        _e_mu_alpha :: a
_e_mu_alpha = Partition -> a -> a
forall a. C a => Partition -> a -> a
_e Partition
mu' a
alpha
        ee :: a
ee = a
_e_lambda_alpha a -> a -> a
forall a. C a => a -> a -> a
- a
_e_mu_alpha
        mu'' :: Seq Int
mu'' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu
        l :: Int
l = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu''
        pairs :: [(Int, Int)]
pairs = [(Int
i, Int
j) | Int
i <- [Int
0 .. Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
2], Int
j <- [Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1 .. Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1]]
        triplets :: [(Partition, (Int, Int), Int)]
triplets = 
          ((Partition, (Int, Int), Int) -> Bool)
-> [(Partition, (Int, Int), Int)] -> [(Partition, (Int, Int), Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\Partition
nu -> Partition
nu Partition -> [Partition] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Partition]
parts) (Partition -> Bool)
-> ((Partition, (Int, Int), Int) -> Partition)
-> (Partition, (Int, Int), Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition, (Int, Int), Int) -> Partition
forall a b c. (a, b, c) -> a
fst3)
            (
              [Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus Seq Int
mu'' (Int
i, Int
j) Int
r 
                      | (Int
i, Int
j) <- [(Int, Int)]
pairs, Int
r <- [Int
1 .. Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
j Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1]]
              [(Partition, (Int, Int), Int)]
-> [(Partition, (Int, Int), Int)] -> [(Partition, (Int, Int), Int)]
forall a. [a] -> [a] -> [a]
++
              [Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus' Seq Int
mu'' (Int
i, Int
j) (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
j) 
                      | (Int
i, Int
j) <- [(Int, Int)]
pairs]
            )
        kNumber :: a
kNumber = 
          [a] -> a
forall a. C a => [a] -> a
AlgAdd.sum [
              Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
P.- Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
P.+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
r) 
              a -> a -> a
forall a. C a => a -> a -> a
* (Map Partition a
previous Map Partition a -> Partition -> a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
nu)  
              | (Partition
nu, (Int
i, Int
j), Int
r) <- [(Partition, (Int, Int), Int)]
triplets
            ] a -> a -> a
forall a. C a => a -> a -> a
/ a
ee

_inverseKostkaMatrix :: 
  (Eq a, AlgField.C a) 
  => Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_inverseKostkaMatrix :: forall a.
(Eq a, C a) =>
Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_inverseKostkaMatrix Int
n Int
weight a
alpha Char
which = 
  [(Partition, Map Partition a)] -> Map Partition (Map Partition a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition] -> [Map Partition a] -> [(Partition, Map Partition a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas [Int -> Map Partition a
maps Int
i | Int
i <- [Int
1 .. [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
lambdas]])
  where
    kostkaNumbers :: Map Partition (Map Partition a)
kostkaNumbers = Int -> Int -> a -> Char -> Map Partition (Map Partition a)
forall a.
C a =>
Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_kostkaNumbers Int
n Int
weight a
alpha Char
which
    lambdas :: [Partition]
lambdas = [Partition] -> [Partition]
forall a. [a] -> [a]
reverse ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ Map Partition (Map Partition a) -> [Partition]
forall k a. Map k a -> [k]
DM.keys Map Partition (Map Partition a)
kostkaNumbers
    msCombo :: Partition -> Map Partition a
msCombo Partition
lambda = Map Partition (Map Partition a)
kostkaNumbers Map Partition (Map Partition a) -> Partition -> Map Partition a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda
    row :: Partition -> [a]
row Partition
lambda = 
      (Partition -> a) -> [Partition] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((Partition -> Map Partition a -> a)
-> Map Partition a -> Partition -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Partition -> Map Partition a -> a
forall k a. Ord k => a -> k -> Map k a -> a
DM.findWithDefault a
forall a. C a => a
AlgAdd.zero) (Partition -> Map Partition a
msCombo Partition
lambda)) [Partition]
lambdas
    matrix :: Matrix a
matrix = Matrix a -> Matrix a
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseTriangularMatrix ([[a]] -> Matrix a
forall a. [[a]] -> Matrix a
fromLists ((Partition -> [a]) -> [Partition] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> [a]
row [Partition]
lambdas))
    maps :: Int -> Map Partition a
maps Int
i = (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) 
          ([(Partition, a)] -> Map Partition a
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition] -> [a] -> [(Partition, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas (Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Int -> Matrix a -> Vector a
forall a. Int -> Matrix a -> Vector a
getRow Int
i Matrix a
matrix))))

_kostkaNumbers :: 
  forall a. (AlgField.C a) 
  => Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_kostkaNumbers :: forall a.
C a =>
Int -> Int -> a -> Char -> Map Partition (Map Partition a)
_kostkaNumbers Int
nv Int
weight a
alpha Char
which = 
  [(Partition, Map Partition a)] -> Map Partition (Map Partition a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctAscList 
    [
      (Partition
lambda, Int -> Partition -> a -> Char -> Map Partition a
forall a. C a => Int -> Partition -> a -> Char -> Map Partition a
_kostkaNumbersWithGivenLambda Int
nv Partition
lambda a
alpha Char
which)
      | Partition
lambda' <- (Int, Int) -> Int -> [Partition]
partitions' (Int
weight, Int
nv) Int
weight
      , let lambda :: Partition
lambda = Partition -> Partition
fromPartition Partition
lambda'
    ]

_symbolicKostkaNumbersWithGivenLambda :: 
  forall a. (Eq a, AlgField.C a) 
  => Int -> Partition -> Char -> Map Partition (RatioOfSprays a)
_symbolicKostkaNumbersWithGivenLambda :: forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> Map Partition (RatioOfSprays a)
_symbolicKostkaNumbersWithGivenLambda Int
nv Partition
lambda Char
which = Int -> Map Partition (RatioOfSprays a)
rec ([Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
mus')
  where
    kN1 :: RatioOfSprays a
kN1 = case Char
which of
      Char
'J' -> Spray a -> RatioOfSprays a
forall a. C a => Spray a -> RatioOfSprays a
asRatioOfSprays (Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffPinv Partition
lambda)
      Char
'P' -> RatioOfSprays a
forall a. (C a, Eq a) => RatioOfSprays a
unitRatioOfSprays
      Char
'C' -> (Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffPinv Partition
lambda :: Spray a) Spray a -> RatioOfSprays a -> RatioOfSprays a
forall a v. C a v => a -> v -> v
*> Partition -> RatioOfSprays a
forall a. (Eq a, C a) => Partition -> RatioOfSprays a
jackSymbolicCoeffC Partition
lambda
      Char
'Q' -> Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffPinv Partition
lambda Spray a -> Spray a -> RatioOfSprays a
forall a. (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a
%//% Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffQinv Partition
lambda
      Char
_   -> [Char] -> RatioOfSprays a
forall a. HasCallStack => [Char] -> a
error [Char]
"_symbolicKostkaNumbersWithGivenLambda: should not happen."
    mu_r_plus :: 
      Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
    mu_r_plus :: Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus Seq Int
mu pair :: (Int, Int)
pair@(Int
i, Int
j) Int
r = 
      (
          Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> Partition) -> Seq Int -> Partition
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Seq a -> Seq a
S.reverse (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Ord a => Seq a -> Seq a
S.sort (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ 
            (Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' (Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.+) Int
r) Int
i ((Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
r) Int
j Seq Int
mu)
        , (Int, Int)
pair
        , Int
r
      )
    mu_r_plus' :: 
      Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
    mu_r_plus' :: Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus' Seq Int
mu pair :: (Int, Int)
pair@(Int
i, Int
j) Int
r = 
      (
          Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> Partition) -> Seq Int -> Partition
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Seq a -> Seq a
S.reverse (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Ord a => Seq a -> Seq a
S.sort (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> a -> b
$ 
            Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.deleteAt Int
j ((Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust' (Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.+) Int
r) Int
i Seq Int
mu)
        , (Int, Int)
pair
        , Int
r
      )
    lambda' :: Partition
lambda' = Partition -> Partition
toPartitionUnsafe Partition
lambda
    mus' :: [Partition]
mus' = [Partition] -> [Partition]
forall a. [a] -> [a]
reverse ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ 
      (Partition -> Bool) -> [Partition] -> [Partition]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Partition
part -> Partition -> Int
partitionWidth Partition
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nv) (Partition -> [Partition]
dominatedPartitions Partition
lambda')
    _e_lambda :: Spray a
_e_lambda = Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
_eSymbolic Partition
lambda' 
    rec :: Int -> Map Partition (RatioOfSprays a)
    rec :: Int -> Map Partition (RatioOfSprays a)
rec Int
n = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      then Partition -> RatioOfSprays a -> Map Partition (RatioOfSprays a)
forall k a. k -> a -> Map k a
DM.singleton Partition
lambda RatioOfSprays a
kN1
      else Partition
-> RatioOfSprays a
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
DM.insert Partition
mu RatioOfSprays a
kNumber Map Partition (RatioOfSprays a)
previous 
      where
        previous :: Map Partition (RatioOfSprays a)
previous = Int -> Map Partition (RatioOfSprays a)
rec (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
        parts :: [Partition]
parts = Map Partition (RatioOfSprays a) -> [Partition]
forall k a. Map k a -> [k]
DM.keys Map Partition (RatioOfSprays a)
previous
        mu' :: Partition
mu' = [Partition]
mus' [Partition] -> Int -> Partition
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
        mu :: Partition
mu = Partition -> Partition
fromPartition Partition
mu'
        _e_mu :: Spray a
_e_mu = Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
_eSymbolic Partition
mu' 
        ee :: Spray a
ee = Spray a
_e_lambda Spray a -> Spray a -> Spray a
forall a. C a => a -> a -> a
- Spray a
_e_mu
        mu'' :: Seq Int
mu'' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
mu
        l :: Int
l = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
mu''
        pairs :: [(Int, Int)]
pairs = [(Int
i, Int
j) | Int
i <- [Int
0 .. Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
2], Int
j <- [Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1 .. Int
lInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1]]
        triplets :: [(Partition, (Int, Int), Int)]
triplets = 
          ((Partition, (Int, Int), Int) -> Bool)
-> [(Partition, (Int, Int), Int)] -> [(Partition, (Int, Int), Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\Partition
nu -> Partition
nu Partition -> [Partition] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Partition]
parts) (Partition -> Bool)
-> ((Partition, (Int, Int), Int) -> Partition)
-> (Partition, (Int, Int), Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition, (Int, Int), Int) -> Partition
forall a b c. (a, b, c) -> a
fst3)
            (
              [Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus Seq Int
mu'' (Int
i, Int
j) Int
r 
                      | (Int
i, Int
j) <- [(Int, Int)]
pairs, Int
r <- [Int
1 .. Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
j Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1]]
              [(Partition, (Int, Int), Int)]
-> [(Partition, (Int, Int), Int)] -> [(Partition, (Int, Int), Int)]
forall a. [a] -> [a] -> [a]
++
              [Seq Int -> (Int, Int) -> Int -> (Partition, (Int, Int), Int)
mu_r_plus' Seq Int
mu'' (Int
i, Int
j) (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
j) 
                      | (Int
i, Int
j) <- [(Int, Int)]
pairs]
            )
        kNumber :: RatioOfSprays a
kNumber = 
          [RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum [
              (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
P.- Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
S.index Seq Int
mu'' Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
P.+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
r) 
                Int -> RatioOfSprays a -> RatioOfSprays a
forall a. (C a, Eq a) => Int -> a -> a
.^ (Map Partition (RatioOfSprays a)
previous Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
nu)  
              | (Partition
nu, (Int
i, Int
j), Int
r) <- [(Partition, (Int, Int), Int)]
triplets
            ] RatioOfSprays a -> Spray a -> RatioOfSprays a
forall a.
(Eq a, C a) =>
RatioOfSprays a -> Spray a -> RatioOfSprays a
%/% Spray a
ee

_symbolicKostkaNumbers :: 
  forall a. (Eq a, AlgField.C a) 
  => Int -> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_symbolicKostkaNumbers :: forall a.
(Eq a, C a) =>
Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_symbolicKostkaNumbers Int
nv Int
weight Char
which = 
  [(Partition, Map Partition (RatioOfSprays a))]
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a. [(k, a)] -> Map k a
DM.fromDistinctAscList 
    [
      (Partition
lambda, Int -> Partition -> Char -> Map Partition (RatioOfSprays a)
forall a.
(Eq a, C a) =>
Int -> Partition -> Char -> Map Partition (RatioOfSprays a)
_symbolicKostkaNumbersWithGivenLambda Int
nv Partition
lambda Char
which)
      | Partition
lambda' <- (Int, Int) -> Int -> [Partition]
partitions' (Int
weight, Int
nv) Int
weight
      , let lambda :: Partition
lambda = Partition -> Partition
fromPartition Partition
lambda'
    ]

_inverseSymbolicKostkaMatrix :: 
  (Eq a, AlgField.C a) 
  => Int -> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_inverseSymbolicKostkaMatrix :: forall a.
(Eq a, C a) =>
Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_inverseSymbolicKostkaMatrix Int
n Int
weight Char
which = 
  [(Partition, Map Partition (RatioOfSprays a))]
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition]
-> [Map Partition (RatioOfSprays a)]
-> [(Partition, Map Partition (RatioOfSprays a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas [Int -> Map Partition (RatioOfSprays a)
maps Int
i | Int
i <- [Int
1 .. [Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
lambdas]])
  where
    kostkaNumbers :: Map Partition (Map Partition (RatioOfSprays a))
kostkaNumbers = Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
forall a.
(Eq a, C a) =>
Int
-> Int -> Char -> Map Partition (Map Partition (RatioOfSprays a))
_symbolicKostkaNumbers Int
n Int
weight Char
which
    lambdas :: [Partition]
lambdas = [Partition] -> [Partition]
forall a. [a] -> [a]
reverse ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ Map Partition (Map Partition (RatioOfSprays a)) -> [Partition]
forall k a. Map k a -> [k]
DM.keys Map Partition (Map Partition (RatioOfSprays a))
kostkaNumbers
    msCombo :: Partition -> Map Partition (RatioOfSprays a)
msCombo Partition
lambda = Map Partition (Map Partition (RatioOfSprays a))
kostkaNumbers Map Partition (Map Partition (RatioOfSprays a))
-> Partition -> Map Partition (RatioOfSprays a)
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
lambda
    row :: Partition -> Partition -> RatioOfSprays a
row = (Partition -> Map Partition (RatioOfSprays a) -> RatioOfSprays a)
-> Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RatioOfSprays a
-> Partition -> Map Partition (RatioOfSprays a) -> RatioOfSprays a
forall k a. Ord k => a -> k -> Map k a -> a
DM.findWithDefault RatioOfSprays a
forall a. (C a, Eq a) => RatioOfSprays a
zeroRatioOfSprays) (Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a)
-> (Partition -> Map Partition (RatioOfSprays a))
-> Partition
-> Partition
-> RatioOfSprays a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> Map Partition (RatioOfSprays a)
msCombo
    matrix :: Matrix (RatioOfSprays a)
matrix =
      Matrix (RatioOfSprays a) -> Matrix (RatioOfSprays a)
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseTriangularMatrix ([[RatioOfSprays a]] -> Matrix (RatioOfSprays a)
forall a. [[a]] -> Matrix a
fromLists [(Partition -> RatioOfSprays a) -> [Partition] -> [RatioOfSprays a]
forall a b. (a -> b) -> [a] -> [b]
map (Partition -> Partition -> RatioOfSprays a
row Partition
mu) [Partition]
lambdas | Partition
mu <- [Partition]
lambdas])
    maps :: Int -> Map Partition (RatioOfSprays a)
maps Int
i = (RatioOfSprays a -> Bool)
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
forall a k. (a -> Bool) -> Map k a -> Map k a
DM.filter (RatioOfSprays a -> RatioOfSprays a -> Bool
forall a. Eq a => a -> a -> Bool
/= RatioOfSprays a
forall a. (C a, Eq a) => RatioOfSprays a
zeroRatioOfSprays) 
          ([(Partition, RatioOfSprays a)] -> Map Partition (RatioOfSprays a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList ([Partition] -> [RatioOfSprays a] -> [(Partition, RatioOfSprays a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Partition]
lambdas (Vector (RatioOfSprays a) -> [RatioOfSprays a]
forall a. Vector a -> [a]
V.toList (Int -> Matrix (RatioOfSprays a) -> Vector (RatioOfSprays a)
forall a. Int -> Matrix a -> Vector a
getRow Int
i Matrix (RatioOfSprays a)
matrix))))

inverseTriangularMatrix :: (Eq a, AlgField.C a) => Matrix a -> Matrix a
inverseTriangularMatrix :: forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseTriangularMatrix Matrix a
mat = 
  if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then [[a]] -> Matrix a
forall a. [[a]] -> Matrix a
fromLists [[a -> a
forall a. C a => a -> a
recip (Int -> Int -> Matrix a -> a
forall a. Int -> Int -> Matrix a -> a
getElem Int
1 Int
1 Matrix a
mat)]] else Matrix a
invmat
  where
    d :: Int
d = Matrix a -> Int
forall a. Matrix a -> Int
nrows Matrix a
mat
    invminor :: Matrix a
invminor = Matrix a -> Matrix a
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseTriangularMatrix (Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
minorMatrix Int
d Int
d Matrix a
mat)
    lastColumn :: Vector a
lastColumn = Vector a -> Vector a
forall a. Vector a -> Vector a
V.init (Int -> Matrix a -> Vector a
forall a. Int -> Matrix a -> Vector a
getCol Int
d Matrix a
mat)
    vectors :: [(Vector a, Vector a)]
vectors = [
        (
          Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) (Int -> Matrix a -> Vector a
forall a. Int -> Matrix a -> Vector a
getRow Int
i Matrix a
invminor)
        , Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Vector a
lastColumn
        )
        | Int
i <- [Int
1 .. Int
dInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1]
      ] 
    lastEntry :: a
lastEntry = a -> a
forall a. C a => a -> a
recip (Int -> Int -> Matrix a -> a
forall a. Int -> Int -> Matrix a -> a
getElem Int
d Int
d Matrix a
mat)
    newColumn :: Matrix a
newColumn = Vector a -> Matrix a
forall a. Vector a -> Matrix a
colVector ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList 
        [a -> a
forall a. C a => a -> a
AlgAdd.negate (a
lastEntry a -> a -> a
forall a. C a => a -> a -> a
* (a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1 a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) ((a -> a -> a) -> Vector a -> Vector a -> Vector a
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) Vector a
u Vector a
v)) 
          | (Vector a
u, Vector a
v) <- [(Vector a, Vector a)]
vectors]
      )
    newRow :: Matrix a
newRow = Vector a -> Matrix a
forall a. Vector a -> Matrix a
rowVector (Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc (Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate (Int
d Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1) a
forall a. C a => a
AlgAdd.zero) a
lastEntry)
    invmat :: Matrix a
invmat = (Matrix a
invminor Matrix a -> Matrix a -> Matrix a
forall a. Matrix a -> Matrix a -> Matrix a
<|> Matrix a
newColumn) Matrix a -> Matrix a -> Matrix a
forall a. Matrix a -> Matrix a -> Matrix a
<-> Matrix a
newRow

inverseUnitTriangularMatrix :: (Eq a, AlgRing.C a) => Matrix a -> Matrix a
inverseUnitTriangularMatrix :: forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseUnitTriangularMatrix Matrix a
mat = 
  if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Matrix a
mat else Matrix a
invmat
  where
    d :: Int
d = Matrix a -> Int
forall a. Matrix a -> Int
nrows Matrix a
mat
    invminor :: Matrix a
invminor = Matrix a -> Matrix a
forall a. (Eq a, C a) => Matrix a -> Matrix a
inverseUnitTriangularMatrix (Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
minorMatrix Int
d Int
d Matrix a
mat)
    lastColumn :: Vector a
lastColumn = Vector a -> Vector a
forall a. Vector a -> Vector a
V.init (Int -> Matrix a -> Vector a
forall a. Int -> Matrix a -> Vector a
getCol Int
d Matrix a
mat)
    vectors :: [(Vector a, Vector a)]
vectors = [
        (
          Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) (Int -> Matrix a -> Vector a
forall a. Int -> Matrix a -> Vector a
getRow Int
i Matrix a
invminor)
        , Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop (Int
iInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Vector a
lastColumn
        )
        | Int
i <- [Int
1 .. Int
dInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1]
      ] 
    newColumn :: Matrix a
newColumn = Vector a -> Matrix a
forall a. Vector a -> Matrix a
colVector ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList 
        [a -> a
forall a. C a => a -> a
AlgAdd.negate ((a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1 a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) ((a -> a -> a) -> Vector a -> Vector a -> Vector a
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) Vector a
u Vector a
v)) 
          | (Vector a
u, Vector a
v) <- [(Vector a, Vector a)]
vectors]
      )
    newRow :: Matrix a
newRow = Vector a -> Matrix a
forall a. Vector a -> Matrix a
rowVector (Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc (Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate (Int
d Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1) a
forall a. C a => a
AlgAdd.zero) a
forall a. C a => a
AlgRing.one)
    invmat :: Matrix a
invmat = (Matrix a
invminor Matrix a -> Matrix a -> Matrix a
forall a. Matrix a -> Matrix a -> Matrix a
<|> Matrix a
newColumn) Matrix a -> Matrix a -> Matrix a
forall a. Matrix a -> Matrix a -> Matrix a
<-> Matrix a
newRow

_isPartition :: Partition -> Bool
_isPartition :: Partition -> Bool
_isPartition []           = Bool
True
_isPartition [Int
x]          = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
_isPartition (Int
x:xs :: Partition
xs@(Int
y:Partition
_)) = (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
y) Bool -> Bool -> Bool
&& Partition -> Bool
_isPartition Partition
xs

_diffSequence :: [Int] -> [Int]
_diffSequence :: Partition -> Partition
_diffSequence = Partition -> Partition
forall {a}. C a => [a] -> [a]
go where
  go :: [a] -> [a]
go (a
x:ys :: [a]
ys@(a
y:[a]
_)) = (a
xa -> a -> a
forall a. C a => a -> a -> a
-a
y) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
ys 
  go [a
x]          = [a
x]
  go []           = []

_dualPartition :: Partition -> Partition
_dualPartition :: Partition -> Partition
_dualPartition [] = []
_dualPartition Partition
xs = Int -> Partition -> Partition -> Partition
forall {t}. (C t, Num t) => t -> Partition -> Partition -> [t]
go Int
0 (Partition -> Partition
_diffSequence Partition
xs) [] where
  go :: t -> Partition -> Partition -> [t]
go !t
i (Int
d:Partition
ds) Partition
acc = t -> Partition -> Partition -> [t]
go (t
it -> t -> t
forall a. C a => a -> a -> a
+t
1) Partition
ds (Int
dInt -> Partition -> Partition
forall a. a -> [a] -> [a]
:Partition
acc)
  go t
n  []     Partition
acc = t -> Partition -> [t]
forall {t}. (C t, Num t) => t -> Partition -> [t]
finish t
n Partition
acc 
  finish :: t -> Partition -> [t]
finish !t
j (Int
k:Partition
ks) = Int -> t -> [t]
forall a. Int -> a -> [a]
replicate Int
k t
j [t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++ t -> Partition -> [t]
finish (t
jt -> t -> t
forall a. C a => a -> a -> a
-t
1) Partition
ks
  finish t
_  []     = []

_ij :: Partition -> ([Int], [Int])
_ij :: Partition -> (Partition, Partition)
_ij Partition
lambda =
  (
    (Int -> Int -> Partition) -> Partition -> Partition
forall a b. (Int -> a -> [b]) -> [a] -> [b]
iconcatMap (\Int
i Int
a ->  Int -> Int -> Partition
forall a. Int -> a -> [a]
replicate Int
a (Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1)) Partition
lambda,
    (Int -> Partition) -> Partition -> Partition
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
a -> [Int
1 .. Int
a]) ((Int -> Bool) -> Partition -> Partition
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) Partition
lambda)
  )

_convParts :: AlgRing.C b => [Int] -> ([b], [b])
_convParts :: forall b. C b => Partition -> ([b], [b])
_convParts Partition
lambda =
  ((Int -> b) -> Partition -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Partition
lambda, (Int -> b) -> Partition -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral (Partition -> Partition
_dualPartition Partition
lambda))

_N :: [Int] -> [Int] -> Int
_N :: Partition -> Partition -> Int
_N Partition
lambda Partition
mu = 
  Partition -> Int
forall a. C a => [a] -> a
sum (Partition -> Int) -> Partition -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Partition -> Int) -> Partition -> [Partition] -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Partition
xs -> Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
* Partition -> Int
forall a. C a => [a] -> a
product Partition
xs) Partition
mu (Partition -> [Partition]
forall a. [a] -> [[a]]
tails ((Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) (Partition -> Partition
forall a. [a] -> [a]
drop1 Partition
lambda)))

hookLengths :: AlgRing.C a => Partition -> a -> ([a], [a])
hookLengths :: forall a. C a => Partition -> a -> ([a], [a])
hookLengths Partition
lambda a
alpha = ([a]
lower, [a]
upper)
  where
    (Partition
i, Partition
j) = Partition -> (Partition, Partition)
_ij Partition
lambda
    ([a]
lambda', [a]
lambdaConj') = Partition -> ([a], [a])
forall b. C b => Partition -> ([b], [b])
_convParts Partition
lambda
    upper :: [a]
upper = (Int -> Int -> a) -> Partition -> Partition -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> [a] -> Int -> Int -> a
fup [a]
lambdaConj' [a]
lambda') Partition
i Partition
j
      where
        fup :: [a] -> [a] -> Int -> Int -> a
fup [a]
x [a]
y Int
ii Int
jj =
          [a]
x[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
jjInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
ii a -> a -> a
forall a. C a => a -> a -> a
+ 
            a
alpha a -> a -> a
forall a. C a => a -> a -> a
* ([a]
y[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
iiInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int
jj Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1))
    lower :: [a]
lower = (Int -> Int -> a) -> Partition -> Partition -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> [a] -> Int -> Int -> a
flow [a]
lambdaConj' [a]
lambda') Partition
i Partition
j
      where
        flow :: [a] -> [a] -> Int -> Int -> a
flow [a]
x [a]
y Int
ii Int
jj =
          [a]
x[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
jjInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- (Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
ii Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1) a -> a -> a
forall a. C a => a -> a -> a
+ 
            a
alpha a -> a -> a
forall a. C a => a -> a -> a
* ([a]
y[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
iiInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
jj)

_productHookLengths :: AlgRing.C a => Partition -> a -> a
_productHookLengths :: forall a. C a => Partition -> a -> a
_productHookLengths Partition
lambda a
alpha = [a] -> a
forall a. C a => [a] -> a
product [a]
lower a -> a -> a
forall a. C a => a -> a -> a
* [a] -> a
forall a. C a => [a] -> a
product [a]
upper
  where
    ([a]
lower, [a]
upper) = Partition -> a -> ([a], [a])
forall a. C a => Partition -> a -> ([a], [a])
hookLengths Partition
lambda a
alpha

jackCoeffC :: AlgField.C a => Partition -> a -> a
jackCoeffC :: forall a. C a => Partition -> a -> a
jackCoeffC Partition
lambda a
alpha = 
  a
alphaa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
k a -> a -> a
forall a. C a => a -> a -> a
* Integer -> a
forall a. C a => Integer -> a
fromInteger ([Integer] -> Integer
forall a. C a => [a] -> a
product [Integer
2 .. Integer
k]) a -> a -> a
forall a. C a => a -> a -> a
* a -> a
forall a. C a => a -> a
recip a
jlambda
  where
    k :: Integer
k = Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral (Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda)
    jlambda :: a
jlambda = Partition -> a -> a
forall a. C a => Partition -> a -> a
_productHookLengths Partition
lambda a
alpha

jackCoeffP :: AlgField.C a => Partition -> a -> a
jackCoeffP :: forall a. C a => Partition -> a -> a
jackCoeffP Partition
lambda a
alpha = a
forall a. C a => a
one a -> a -> a
forall a. C a => a -> a -> a
/ [a] -> a
forall a. C a => [a] -> a
product [a]
lower
  where
    ([a]
lower, [a]
_) = Partition -> a -> ([a], [a])
forall a. C a => Partition -> a -> ([a], [a])
hookLengths Partition
lambda a
alpha

jackCoeffQ :: AlgField.C a => Partition -> a -> a
jackCoeffQ :: forall a. C a => Partition -> a -> a
jackCoeffQ Partition
lambda a
alpha = a
forall a. C a => a
one a -> a -> a
forall a. C a => a -> a -> a
/ [a] -> a
forall a. C a => [a] -> a
product [a]
upper
  where
    ([a]
_, [a]
upper) = Partition -> a -> ([a], [a])
forall a. C a => Partition -> a -> ([a], [a])
hookLengths Partition
lambda a
alpha

symbolicHookLengthsProducts :: forall a. (Eq a, AlgRing.C a) 
  => Partition -> (Spray a, Spray a)
symbolicHookLengthsProducts :: forall a. (Eq a, C a) => Partition -> (Spray a, Spray a)
symbolicHookLengthsProducts Partition
lambda = ([Spray a] -> Spray a
forall a. C a => [a] -> a
product [Spray a]
lower, [Spray a] -> Spray a
forall a. C a => [a] -> a
product [Spray a]
upper)
  where
    alpha :: Spray a
alpha = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
1 :: Spray a
    (Partition
i, Partition
j) = Partition -> (Partition, Partition)
_ij Partition
lambda
    ([a]
lambda', [a]
lambdaConj') = Partition -> ([a], [a])
forall b. C b => Partition -> ([b], [b])
_convParts Partition
lambda
    upper :: [Spray a]
upper = (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> [a] -> Int -> Int -> Spray a
fup [a]
lambdaConj' [a]
lambda') Partition
i Partition
j
      where
        fup :: [a] -> [a] -> Int -> Int -> Spray a
fup [a]
x [a]
y Int
ii Int
jj =
          ([a]
x[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
jjInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
ii) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> 
            (([a]
y[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
iiInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int
jj Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
alpha)
    lower :: [Spray a]
lower = (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> [a] -> Int -> Int -> Spray a
flow [a]
lambdaConj' [a]
lambda') Partition
i Partition
j
      where
        flow :: [a] -> [a] -> Int -> Int -> Spray a
flow [a]
x [a]
y Int
ii Int
jj =
          ([a]
x[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
jjInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int
ii Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> 
            (([a]
y[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
iiInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
jj) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
alpha)

symbolicHookLengthsProduct :: (Eq a, AlgRing.C a) => Partition -> Spray a
symbolicHookLengthsProduct :: forall a. (Eq a, C a) => Partition -> Spray a
symbolicHookLengthsProduct Partition
lambda = Spray a
lower Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
upper
  where
    (Spray a
lower, Spray a
upper) = Partition -> (Spray a, Spray a)
forall a. (Eq a, C a) => Partition -> (Spray a, Spray a)
symbolicHookLengthsProducts Partition
lambda

jackSymbolicCoeffC :: 
  forall a. (Eq a, AlgField.C a) => Partition -> RatioOfSprays a
jackSymbolicCoeffC :: forall a. (Eq a, C a) => Partition -> RatioOfSprays a
jackSymbolicCoeffC Partition
lambda = 
  ((Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
factorialk) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
alphaSpray a -> Int -> Spray a
forall b. (FunctionLike b, C b) => b -> Int -> b
^**^Int
k) Spray a -> Spray a -> RatioOfSprays a
forall a. Spray a -> Spray a -> RatioOfSprays a
%:% Spray a
jlambda
  where
    alpha :: Spray a
alpha      = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
1 :: Spray a
    k :: Int
k          = Partition -> Int
forall a. C a => [a] -> a
sum Partition
lambda
    factorialk :: Int
factorialk = Partition -> Int
forall a. C a => [a] -> a
product [Int
2 .. Int
k]
    jlambda :: Spray a
jlambda    = Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
symbolicHookLengthsProduct Partition
lambda

jackSymbolicCoeffPinv :: (Eq a, AlgField.C a) => Partition -> Spray a
jackSymbolicCoeffPinv :: forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffPinv Partition
lambda = Spray a
lower 
  where 
    (Spray a
lower, Spray a
_) = Partition -> (Spray a, Spray a)
forall a. (Eq a, C a) => Partition -> (Spray a, Spray a)
symbolicHookLengthsProducts Partition
lambda

jackSymbolicCoeffQinv :: (Eq a, AlgField.C a) => Partition -> Spray a 
jackSymbolicCoeffQinv :: forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffQinv Partition
lambda = Spray a
upper 
  where 
    (Spray a
_, Spray a
upper) = Partition -> (Spray a, Spray a)
forall a. (Eq a, C a) => Partition -> (Spray a, Spray a)
symbolicHookLengthsProducts Partition
lambda

_betaratio :: AlgField.C a => Partition -> Partition -> Int -> a -> a
_betaratio :: forall a. C a => Partition -> Partition -> Int -> a -> a
_betaratio Partition
kappa Partition
mu Int
k a
alpha = a
alpha a -> a -> a
forall a. C a => a -> a -> a
* a
prod1 a -> a -> a
forall a. C a => a -> a -> a
* a
prod2 a -> a -> a
forall a. C a => a -> a -> a
* a
prod3
  where
    mukm1 :: Int
mukm1 = Partition
mu Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! (Int
kInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
    t :: a
t = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
k a -> a -> a
forall a. C a => a -> a -> a
- a
alpha a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
mukm1
    u :: [a]
u = (Int -> Int -> a) -> Partition -> Partition -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
s Int
kap -> a
t a -> a -> a
forall a. C a => a -> a -> a
+ a
forall a. C a => a
one a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
s a -> a -> a
forall a. C a => a -> a -> a
+ a
alpha a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
kap)
                [Int
1 .. Int
k] Partition
kappa 
    v :: [a]
v = (Int -> Int -> a) -> Partition -> Partition -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
s Int
m -> a
t a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
s a -> a -> a
forall a. C a => a -> a -> a
+ a
alpha a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
m)
                [Int
1 .. Int
kInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1] Partition
mu 
    w :: [a]
w = (Int -> Int -> a) -> Partition -> Partition -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
s Int
m -> Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
m a -> a -> a
forall a. C a => a -> a -> a
- a
t a -> a -> a
forall a. C a => a -> a -> a
- a
alpha a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
s)
                [Int
1 .. Int
mukm1Int -> Int -> Int
forall a. C a => a -> a -> a
-Int
1] (Partition -> Partition
_dualPartition Partition
mu)
    prod1 :: a
prod1 = [a] -> a
forall a. C a => [a] -> a
product ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a
x a -> a -> a
forall a. C a => a -> a -> a
/ (a
x a -> a -> a
forall a. C a => a -> a -> a
+ a
alpha a -> a -> a
forall a. C a => a -> a -> a
- a
forall a. C a => a
one)) [a]
u
    prod2 :: a
prod2 = [a] -> a
forall a. C a => [a] -> a
product ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x a -> a -> a
forall a. C a => a -> a -> a
+ a
alpha) a -> a -> a
forall a. C a => a -> a -> a
/ a
x) [a]
v
    prod3 :: a
prod3 = [a] -> a
forall a. C a => [a] -> a
product ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x a -> a -> a
forall a. C a => a -> a -> a
+ a
alpha) a -> a -> a
forall a. C a => a -> a -> a
/ a
x) [a]
w

_betaRatioOfSprays :: forall a. (Eq a, AlgField.C a)
  => Partition -> Partition -> Int -> RatioOfSprays a
_betaRatioOfSprays :: forall a.
(Eq a, C a) =>
Partition -> Partition -> Int -> RatioOfSprays a
_betaRatioOfSprays Partition
kappa Partition
mu Int
k = 
  ((Spray a
x Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
num1 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
num2 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
num3) Spray a -> Spray a -> RatioOfSprays a
forall a. Spray a -> Spray a -> RatioOfSprays a
%:% (Spray a
den1 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
den2 Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^*^ Spray a
den3))
  where
    mukm1 :: Int
mukm1 = Partition
mu Partition -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! (Int
kInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
    x :: Spray a
x = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
1 :: Spray a
    u :: [Spray a]
u = (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 
        (
        \Int
s Int
kap -> 
          (Int -> BaseRing (Spray a)
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> BaseRing (Spray a)) -> Int -> BaseRing (Spray a)
forall a b. (a -> b) -> a -> b
$ Int
k Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
s Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> ((Int -> BaseRing (Spray a)
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> BaseRing (Spray a)) -> Int -> BaseRing (Spray a)
forall a b. (a -> b) -> a -> b
$ Int
kap Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
mukm1) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
x)
        )
        [Int
1 .. Int
k] Partition
kappa 
    v :: [Spray a]
v = (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 
        (
        \Int
s Int
m -> (Int -> BaseRing (Spray a)
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> BaseRing (Spray a)) -> Int -> BaseRing (Spray a)
forall a b. (a -> b) -> a -> b
$ Int
k Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
s) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> ((Int -> BaseRing (Spray a)
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> BaseRing (Spray a)) -> Int -> BaseRing (Spray a)
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
mukm1) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
x)
        )
        [Int
1 .. Int
kInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1] Partition
mu 
    w :: [Spray a]
w = (Int -> Int -> Spray a) -> Partition -> Partition -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 
        (
        \Int
s Int
m -> (Int -> BaseRing (Spray a)
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> BaseRing (Spray a)) -> Int -> BaseRing (Spray a)
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
k) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
+> ((Int -> BaseRing (Spray a)
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> BaseRing (Spray a)) -> Int -> BaseRing (Spray a)
forall a b. (a -> b) -> a -> b
$ Int
mukm1 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
s) BaseRing (Spray a) -> Spray a -> Spray a
forall b. FunctionLike b => BaseRing b -> b -> b
*^ Spray a
x)
        )
        [Int
1 .. Int
mukm1Int -> Int -> Int
forall a. C a => a -> a -> a
-Int
1] (Partition -> Partition
_dualPartition Partition
mu)
    num1 :: Spray a
num1 = [Spray a] -> Spray a
forall a. C a => [a] -> a
product [Spray a]
u
    den1 :: Spray a
den1 = [Spray a] -> Spray a
forall a. C a => [a] -> a
product ([Spray a] -> Spray a) -> [Spray a] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Spray a -> Spray a) -> [Spray a] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Spray a
p -> Spray a
p Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ Spray a
x Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^-^ Spray a
forall a. C a => Spray a
unitSpray) [Spray a]
u
    num2 :: Spray a
num2 = [Spray a] -> Spray a
forall a. C a => [a] -> a
product ([Spray a] -> Spray a) -> [Spray a] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Spray a -> Spray a) -> [Spray a] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Spray a
p -> Spray a
p Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ Spray a
x) [Spray a]
v
    den2 :: Spray a
den2 = [Spray a] -> Spray a
forall a. C a => [a] -> a
product [Spray a]
v
    num3 :: Spray a
num3 = [Spray a] -> Spray a
forall a. C a => [a] -> a
product ([Spray a] -> Spray a) -> [Spray a] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Spray a -> Spray a) -> [Spray a] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Spray a
p -> Spray a
p Spray a -> Spray a -> Spray a
forall b. (FunctionLike b, C b) => b -> b -> b
^+^ Spray a
x) [Spray a]
w
    den3 :: Spray a
den3 = [Spray a] -> Spray a
forall a. C a => [a] -> a
product [Spray a]
w

_fromInt :: (AlgRing.C a, Eq a) => Int -> a
_fromInt :: forall a. (C a, Eq a) => Int -> a
_fromInt Int
k = Int
k Int -> a -> a
forall a. (C a, Eq a) => Int -> a -> a
.^ a
forall a. C a => a
AlgRing.one

skewSchurLRCoefficients :: Partition -> Partition -> DM.Map Partition Int
skewSchurLRCoefficients :: Partition -> Partition -> Map Partition Int
skewSchurLRCoefficients Partition
lambda Partition
mu = 
  (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 (Partition -> Partition -> Map Partition Int
_lrRule Partition
lambda' Partition
mu')
  where
    lambda' :: Partition
lambda' = Partition -> Partition
MCP.Partition Partition
lambda
    mu' :: Partition
mu'     = Partition -> Partition
MCP.Partition Partition
mu

isSkewPartition :: Partition -> Partition -> Bool
isSkewPartition :: Partition -> Partition -> Bool
isSkewPartition Partition
lambda Partition
mu = 
  Partition -> Bool
_isPartition Partition
lambda Bool -> Bool -> Bool
&& Partition -> Bool
_isPartition Partition
mu Bool -> Bool -> Bool
&& [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. Ord a => a -> a -> Bool
(>=) Partition
lambda Partition
mu)

sprayToMap :: Spray a -> Map [Int] a
sprayToMap :: forall a. Spray a -> Map Partition a
sprayToMap Spray a
spray = 
  [(Partition, a)] -> Map Partition a
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList (HashMap Partition a -> [(Partition, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Partition a -> [(Partition, a)])
-> HashMap Partition a -> [(Partition, a)]
forall a b. (a -> b) -> a -> b
$ (Powers -> Partition) -> Spray a -> HashMap Partition a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys (Seq Int -> Partition
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> Partition)
-> (Powers -> Seq Int) -> Powers -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Powers -> Seq Int
exponents) Spray a
spray) 

comboToSpray :: (Eq a, AlgRing.C a) => Map Partition a -> Spray a
comboToSpray :: forall a. (Eq a, C a) => Map Partition a -> Spray a
comboToSpray Map Partition a
combo = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
sumOfSprays 
  [ let part' :: Seq Int
part' = Partition -> Seq Int
forall a. [a] -> Seq a
S.fromList Partition
part in 
      Powers -> a -> Spray a
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton (Seq Int -> Int -> Powers
Powers Seq Int
part' (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
part')) a
c 
    | (Partition
part, a
c) <- Map Partition a -> [(Partition, a)]
forall k a. Map k a -> [(k, a)]
DM.toList Map Partition a
combo ]