{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Math.Algebra.Jack.Internal
  ( Partition
  , jackCoeffP
  , jackCoeffQ
  , jackCoeffC
  , jackSymbolicCoeffC
  , jackSymbolicCoeffPinv
  , jackSymbolicCoeffQinv
  , _betaratio
  , _betaRatioOfSprays
  , _isPartition
  , _N
  , _fromInt
  , skewSchurLRCoefficients
  , isSkewPartition
  , sprayToMap
  , comboToSpray
  , _kostkaNumbers
  , _inverseKostkaMatrix
  , _symbolicKostkaNumbers
  , _inverseSymbolicKostkaMatrix
  )
  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.Extra                             ( unsnoc )
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 )
import           Data.Sequence                               ( Seq )
import qualified Data.Sequence                               as S
import           Data.Tuple.Extra                            ( fst3 )
import qualified Data.Vector                                 as V
import           Math.Algebra.Hspray                         ( 
                                                               RatioOfSprays, (%:%), (%//%), (%/%)
                                                             , unitRatioOfSprays
                                                             , zeroRatioOfSprays
                                                             , asRatioOfSprays
                                                             , Spray, (.^)
                                                             , Powers (..)
                                                             , lone, unitSpray
                                                             , sumOfSprays
                                                             , FunctionLike (..)
                                                             )
import           Math.Combinat.Partitions.Integer            (
                                                               fromPartition
                                                             , dualPartition
                                                             , partitions
                                                             , dominates
                                                             , partitionWidth
                                                             )
import qualified Math.Combinat.Partitions.Integer            as MCP
import           Math.Combinat.Tableaux.LittlewoodRichardson ( _lrRule )

type Partition = [Int]


_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))

_inverseKostkaMatrix :: 
  forall a. (Eq a, AlgField.C a) 
  => Int -> Int -> a -> Char -> (Matrix a, [Partition])
_inverseKostkaMatrix :: forall a.
(Eq a, C a) =>
Int -> Int -> a -> Char -> (Matrix a, [Partition])
_inverseKostkaMatrix Int
n Int
weight a
alpha Char
which = 
  (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)), [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

_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 = Map Partition (Map Partition a)
kostkaMatrix'
  where
    coeffsP :: Map Partition a
coeffsP = [(Partition, a)] -> Map Partition a
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
      [(Partition
kappa, a -> a
forall a. C a => a -> a
recip (Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffP Partition
kappa a
alpha))| Partition
kappa <- [Partition]
lambdas']
    coeffsC :: Map Partition a
coeffsC = [(Partition, a)] -> Map Partition a
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
      [(Partition
kappa, Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffC Partition
kappa a
alpha a -> a -> a
forall a. C a => a -> a -> a
/ Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffP Partition
kappa a
alpha) 
        | Partition
kappa <- [Partition]
lambdas'] 
    coeffsQ :: Map Partition a
coeffsQ = [(Partition, a)] -> Map Partition a
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
      [(Partition
kappa, Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffQ Partition
kappa a
alpha a -> a -> a
forall a. C a => a -> a -> a
/ Partition -> a -> a
forall a. C a => Partition -> a -> a
jackCoeffP Partition
kappa a
alpha) 
        | Partition
kappa <- [Partition]
lambdas']    
    kostkaMatrix :: Map Partition (Map Partition a)
kostkaMatrix = (Partition -> Partition)
-> Map Partition (Map Partition a)
-> Map Partition (Map Partition a)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
DM.mapKeys Partition -> Partition
fromPartition (Int -> Map Partition (Map Partition a)
rec ([Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
lambdas))
    kostkaMatrix' :: Map Partition (Map Partition a)
kostkaMatrix' = case Char
which of
      Char
'J' -> (Partition -> Map Partition a -> Map Partition a)
-> Map Partition (Map Partition a)
-> Map Partition (Map Partition a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
kappa Map Partition a
m -> (a -> a) -> Map Partition a -> Map Partition a
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (a -> a -> a
forall a. C a => a -> a -> a
(*) (Map Partition a
coeffsP Map Partition a -> Partition -> a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)) Map Partition a
m) 
                            Map Partition (Map Partition a)
kostkaMatrix
      Char
'P' -> Map Partition (Map Partition a)
kostkaMatrix
      Char
'C' -> (Partition -> Map Partition a -> Map Partition a)
-> Map Partition (Map Partition a)
-> Map Partition (Map Partition a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
kappa Map Partition a
m -> (a -> a) -> Map Partition a -> Map Partition a
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (a -> a -> a
forall a. C a => a -> a -> a
(*) (Map Partition a
coeffsC Map Partition a -> Partition -> a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)) Map Partition a
m) 
                            Map Partition (Map Partition a)
kostkaMatrix
      Char
'Q' -> (Partition -> Map Partition a -> Map Partition a)
-> Map Partition (Map Partition a)
-> Map Partition (Map Partition a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
kappa Map Partition a
m -> (a -> a) -> Map Partition a -> Map Partition a
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (a -> a -> a
forall a. C a => a -> a -> a
(*) (Map Partition a
coeffsQ Map Partition a -> Partition -> a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)) Map Partition a
m) 
                            Map Partition (Map Partition a)
kostkaMatrix
      Char
_   -> [Char] -> Map Partition (Map Partition a)
forall a. HasCallStack => [Char] -> a
error [Char]
"_kostkaNumbers: should not happen."
    mu_r_plus :: 
      Seq Int -> (Int, Int) -> Int -> (MCP.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 = 
      (
        Partition -> Partition
MCP.Partition (Partition -> Partition) -> Partition -> Partition
forall a b. (a -> b) -> a -> b
$ 
          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
$ (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) (Seq Int -> Seq Int) -> Seq Int -> Seq Int
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
      )
    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
part -> Partition -> Int
partitionWidth Partition
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nv) (Int -> [Partition]
partitions Int
weight)
    lambdas' :: [Partition]
lambdas' = (Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
fromPartition [Partition]
lambdas
    rec :: Int -> Map MCP.Partition (Map Partition a)
    rec :: Int -> Map Partition (Map Partition a)
rec Int
n = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      then Partition -> Map Partition a -> Map Partition (Map Partition a)
forall k a. k -> a -> Map k a
DM.singleton (Partition -> Partition
MCP.Partition [Int
weight]) 
                        (Partition -> a -> Map Partition a
forall k a. k -> a -> Map k a
DM.singleton [Int
weight] a
forall a. C a => a
AlgRing.one)
      else Partition
-> Map Partition a
-> Map Partition (Map Partition a)
-> Map Partition (Map Partition a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
DM.insert Partition
mu (Partition -> a -> Map Partition a
forall k a. k -> a -> Map k a
DM.singleton Partition
mu' a
forall a. C a => a
AlgRing.one) 
            (
              [(Partition, Map Partition a)] -> Map Partition (Map Partition a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
              [(
                  Partition
kappa
                , 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' (Map Partition a
newColumn Map Partition a -> Partition -> a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa) (Map Partition (Map Partition a)
previous Map Partition (Map Partition a) -> Partition -> Map Partition a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)
               ) | Partition
kappa <- [Partition]
kappas]
            ) 
      where
        previous :: Map Partition (Map Partition a)
previous = Int -> Map Partition (Map Partition a)
rec (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
        parts :: [Partition]
parts = Int -> [Partition] -> [Partition]
forall a. Int -> [a] -> [a]
take Int
n [Partition]
lambdas
        ([Partition]
kappas, Partition
mu) = Maybe ([Partition], Partition) -> ([Partition], Partition)
forall a. HasCallStack => Maybe a -> a
fromJust ([Partition] -> Maybe ([Partition], Partition)
forall a. [a] -> Maybe ([a], a)
unsnoc [Partition]
parts)
        _e_mu_alpha :: a
_e_mu_alpha = Partition -> a -> a
forall a. C a => Partition -> a -> a
_e Partition
mu a
alpha
        mu' :: Partition
mu' = Partition -> Partition
fromPartition Partition
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 = [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]]
        newColumn :: Map Partition a
newColumn = 
          [(Partition, a)] -> Map Partition a
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList [(Partition
kappa, Partition -> a
f Partition
kappa) | Partition
kappa <- [Partition]
kappas]
        f :: Partition -> a
f Partition
kappa = [a] -> a
forall a. C a => [a] -> a
AlgAdd.sum [a]
xs 
          where
            previousRow :: Map Partition a
previousRow = Map Partition (Map Partition a)
previous Map Partition (Map Partition a) -> Partition -> Map Partition a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa
            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 -> Partition -> Bool
dominates Partition
kappa) (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) [(Partition, (Int, Int), Int)]
triplets
            ee :: a
ee = Partition -> a -> a
forall a. C a => Partition -> a -> a
_e Partition
kappa a
alpha a -> a -> a
forall a. C a => a -> a -> a
- a
_e_mu_alpha
            xs :: [a]
xs = [
              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
previousRow Map Partition a -> Partition -> a
forall k a. Ord k => Map k a -> k -> a
DM.! (Partition -> Partition
fromPartition Partition
nu)) a -> a -> a
forall a. C a => a -> a -> a
/ a
ee 
              | (Partition
nu, (Int
i, Int
j), Int
r) <- [(Partition, (Int, Int), Int)]
triplets'
              ]

_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 = Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix'
  where
    coeffsP :: Map Partition (RatioOfSprays a)
coeffsP = [(Partition, RatioOfSprays a)] -> Map Partition (RatioOfSprays a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
      [(Partition
kappa, 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
kappa))
        | Partition
kappa <- [Partition]
lambdas']
    coeffsC :: Map Partition (RatioOfSprays a)
coeffsC = [(Partition, RatioOfSprays a)] -> Map Partition (RatioOfSprays a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
      [(
          Partition
kappa
        , (Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffPinv Partition
kappa :: 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
kappa
       ) | Partition
kappa <- [Partition]
lambdas']    
    coeffsQ :: Map Partition (RatioOfSprays a)
coeffsQ = [(Partition, RatioOfSprays a)] -> Map Partition (RatioOfSprays a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
      [(
          Partition
kappa
        , Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
jackSymbolicCoeffPinv Partition
kappa 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
kappa
       ) | Partition
kappa <- [Partition]
lambdas']    
    kostkaMatrix :: Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix = (Partition -> Partition)
-> Map Partition (Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
DM.mapKeys Partition -> Partition
fromPartition (Int -> Map Partition (Map Partition (RatioOfSprays a))
rec ([Partition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Partition]
lambdas))
    kostkaMatrix' :: Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix' = case Char
which of
      Char
'J' -> (Partition
 -> Map Partition (RatioOfSprays a)
 -> Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
kappa Map Partition (RatioOfSprays a)
m -> (RatioOfSprays a -> RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
(*) (Map Partition (RatioOfSprays a)
coeffsP Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)) Map Partition (RatioOfSprays a)
m) 
              Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix
      Char
'P' -> Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix
      Char
'C' -> (Partition
 -> Map Partition (RatioOfSprays a)
 -> Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
kappa Map Partition (RatioOfSprays a)
m -> (RatioOfSprays a -> RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
(*) (Map Partition (RatioOfSprays a)
coeffsC Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)) Map Partition (RatioOfSprays a)
m) 
              Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix
      Char
'Q' -> (Partition
 -> Map Partition (RatioOfSprays a)
 -> Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
DM.mapWithKey (\Partition
kappa Map Partition (RatioOfSprays a)
m -> (RatioOfSprays a -> RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
-> Map Partition (RatioOfSprays a)
forall a b k. (a -> b) -> Map k a -> Map k b
DM.map (RatioOfSprays a -> RatioOfSprays a -> RatioOfSprays a
forall a. C a => a -> a -> a
(*) (Map Partition (RatioOfSprays a)
coeffsQ Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)) Map Partition (RatioOfSprays a)
m) 
              Map Partition (Map Partition (RatioOfSprays a))
kostkaMatrix
      Char
_   -> [Char] -> Map Partition (Map Partition (RatioOfSprays a))
forall a. HasCallStack => [Char] -> a
error [Char]
"_symbolicKostkaNumbers: should not happen."
    mu_r_plus :: 
      Seq Int -> (Int, Int) -> Int -> (MCP.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 = 
      (
        Partition -> Partition
MCP.Partition (Partition -> Partition) -> Partition -> Partition
forall a b. (a -> b) -> a -> b
$ 
          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
$ (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) (Seq Int -> Seq Int) -> Seq Int -> Seq Int
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
      )
    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
part -> Partition -> Int
partitionWidth Partition
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nv) (Int -> [Partition]
partitions Int
weight)
    lambdas' :: [Partition]
lambdas' = (Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
fromPartition [Partition]
lambdas
    rec :: Int -> Map MCP.Partition (Map Partition (RatioOfSprays a))
    rec :: Int -> Map Partition (Map Partition (RatioOfSprays a))
rec Int
n = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      then Partition
-> Map Partition (RatioOfSprays a)
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a. k -> a -> Map k a
DM.singleton (Partition -> Partition
MCP.Partition [Int
weight]) 
                        (Partition -> RatioOfSprays a -> Map Partition (RatioOfSprays a)
forall k a. k -> a -> Map k a
DM.singleton [Int
weight] RatioOfSprays a
forall a. (C a, Eq a) => RatioOfSprays a
unitRatioOfSprays)
      else Partition
-> Map Partition (RatioOfSprays a)
-> Map Partition (Map Partition (RatioOfSprays a))
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a. Ord k => k -> a -> Map k a -> Map k a
DM.insert Partition
mu (Partition -> RatioOfSprays a -> Map Partition (RatioOfSprays a)
forall k a. k -> a -> Map k a
DM.singleton Partition
mu' RatioOfSprays a
forall a. (C a, Eq a) => RatioOfSprays a
unitRatioOfSprays) 
        (
          [(Partition, Map Partition (RatioOfSprays a))]
-> Map Partition (Map Partition (RatioOfSprays a))
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList 
          [
            ( 
              Partition
kappa
            , 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' (Map Partition (RatioOfSprays a)
newColumn Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa) (Map Partition (Map Partition (RatioOfSprays a))
previous Map Partition (Map Partition (RatioOfSprays a))
-> Partition -> Map Partition (RatioOfSprays a)
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa)
            ) 
            | Partition
kappa <- [Partition]
kappas
          ]
        ) 
      where
        previous :: Map Partition (Map Partition (RatioOfSprays a))
previous = Int -> Map Partition (Map Partition (RatioOfSprays a))
rec (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
1)
        parts :: [Partition]
parts = Int -> [Partition] -> [Partition]
forall a. Int -> [a] -> [a]
take Int
n [Partition]
lambdas
        ([Partition]
kappas, Partition
mu) = Maybe ([Partition], Partition) -> ([Partition], Partition)
forall a. HasCallStack => Maybe a -> a
fromJust ([Partition] -> Maybe ([Partition], Partition)
forall a. [a] -> Maybe ([a], a)
unsnoc [Partition]
parts)
        _eSymbolic_mu :: Spray a
_eSymbolic_mu = Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
_eSymbolic Partition
mu
        mu' :: Partition
mu' = Partition -> Partition
fromPartition Partition
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 = [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]]
        newColumn :: Map Partition (RatioOfSprays a)
newColumn = 
          [(Partition, RatioOfSprays a)] -> Map Partition (RatioOfSprays a)
forall k a. [(k, a)] -> Map k a
DM.fromDistinctDescList [(Partition
kappa, Partition -> RatioOfSprays a
f Partition
kappa) | Partition
kappa <- [Partition]
kappas]
        f :: Partition -> RatioOfSprays a
f Partition
kappa = [RatioOfSprays a] -> RatioOfSprays a
forall a. C a => [a] -> a
AlgAdd.sum [RatioOfSprays a]
xs 
          where
            previousRow :: Map Partition (RatioOfSprays a)
previousRow = Map Partition (Map Partition (RatioOfSprays a))
previous Map Partition (Map Partition (RatioOfSprays a))
-> Partition -> Map Partition (RatioOfSprays a)
forall k a. Ord k => Map k a -> k -> a
DM.! Partition
kappa
            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 -> Partition -> Bool
dominates Partition
kappa) (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) [(Partition, (Int, Int), Int)]
triplets
            ee :: Spray a
ee = Partition -> Spray a
forall a. (Eq a, C a) => Partition -> Spray a
_eSymbolic Partition
kappa Spray a -> Spray a -> Spray a
forall a. C a => a -> a -> a
- Spray a
_eSymbolic_mu
            xs :: [RatioOfSprays a]
xs = [
              (
                (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)
previousRow Map Partition (RatioOfSprays a) -> Partition -> RatioOfSprays a
forall k a. Ord k => Map k a -> k -> a
DM.! (Partition -> Partition
fromPartition Partition
nu)) 
              ) RatioOfSprays a -> Spray a -> RatioOfSprays a
forall a.
(Eq a, C a) =>
RatioOfSprays a -> Spray a -> RatioOfSprays a
%/% Spray a
ee 
              | (Partition
nu, (Int
i, Int
j), Int
r) <- [(Partition, (Int, Int), Int)]
triplets'
              ]

_inverseSymbolicKostkaMatrix :: 
  forall a. (Eq a, AlgField.C a) 
  => Int -> Int -> Char -> (Matrix (RatioOfSprays a), [Partition])
_inverseSymbolicKostkaMatrix :: forall a.
(Eq a, C a) =>
Int -> Int -> Char -> (Matrix (RatioOfSprays a), [Partition])
_inverseSymbolicKostkaMatrix Int
n Int
weight Char
which = 
--  (inverseTriangularMatrix (fromLists (map (\lambda -> map (row lambda) lambdas) lambdas)), lambdas)

  (
    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])
  , [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
    -- row lambda = 

    --   map (flip (DM.findWithDefault zeroRatioOfSprays) (msCombo lambda)) lambdas


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

_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 -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. C a => a -> a -> a
(*) Partition
mu Partition
prods
  where
  prods :: Partition
prods = (Int -> Int) -> Partition -> Partition
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Partition -> Int
forall a. C a => [a] -> a
product (Partition -> Int) -> Partition -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Partition -> Partition
forall a. Int -> [a] -> [a]
drop Int
i ((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
lambda)) [Int
1 .. Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length 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
&& (Int -> Bool) -> Partition -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) ((Int -> Int -> Int) -> Partition -> Partition -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) 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 ]