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

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

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

    isSymmetricSpray
  -- * Classical symmetric polynomials

  , msPolynomial
  , psPolynomial
  -- * Decomposition of symmetric polynomials

  , msCombination
  , psCombination
  , psCombination'
  -- * Printing symmetric polynomials

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

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

  , hallInnerProduct
  , hallInnerProduct'
  , hallInnerProduct''
  , hallInnerProduct'''
  , hallInnerProduct''''
  , symbolicHallInnerProduct
  , symbolicHallInnerProduct'
  , symbolicHallInnerProduct''
  ) where
import           Prelude hiding ( fromIntegral, fromRational )
import qualified Algebra.Additive                 as AlgAdd
import           Algebra.Field                    ( fromRational )
import qualified Algebra.Field                    as AlgField
import qualified Algebra.Module                   as AlgMod
import qualified Algebra.Ring                     as AlgRing
import           Algebra.ToInteger                ( fromIntegral )
import qualified Data.Foldable                    as DF
import qualified Data.HashMap.Strict              as HM
import           Data.List                        ( foldl1', nub )
import           Data.List.Extra                  ( unsnoc )
import           Data.Map.Strict                  ( 
                                                    Map
                                                  , unionsWith
                                                  , insert
                                                  )
import qualified Data.Map.Strict                  as DM
import           Data.Maybe                       ( fromJust )
import           Data.Map.Merge.Strict            ( 
                                                    merge
                                                  , dropMissing
                                                  , zipWithMatched 
                                                  )
import           Data.Ratio                       ( (%) )
import           Data.Sequence                    ( 
                                                    Seq
                                                  , (|>) 
                                                  )
import qualified Data.Sequence                    as S
import           Data.Tuple.Extra                 ( second )
import           Math.Algebra.Hspray              (
                                                    FunctionLike (..)
                                                  , (/^)
                                                  , Spray
                                                  , Powers (..)
                                                  , QSpray
                                                  , QSpray'
                                                  , ParametricQSpray
                                                  , lone
                                                  , qlone
                                                  , lone'
                                                  , fromList
                                                  , getCoefficient
                                                  , getConstantTerm
                                                  , isConstant
                                                  , (%//%)
                                                  , RatioOfSprays (..)
                                                  , prettyRatioOfQSpraysXYZ
                                                  , showNumSpray
                                                  , showQSpray
                                                  , showQSpray'
                                                  , showSpray
                                                  , toList
                                                  , zeroSpray
                                                  , unitSpray
                                                  , productOfSprays
                                                  , constantSpray
                                                  )
import           Math.Algebra.Jack.Internal       ( Partition , _isPartition )
import           Math.Combinat.Compositions       ( compositions1 )
import           Math.Combinat.Partitions.Integer ( 
                                                    fromPartition
                                                  , mkPartition
                                                  , partitions 
                                                  )
import           Math.Combinat.Permutations       ( permuteMultiset )

-- | Monomial symmetric polynomial

--

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

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

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

  -> Partition -- ^ integer partition

  -> Spray a
msPolynomial :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
msPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"msPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"msPolynomial: invalid partition."
  | Int
llambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n               = Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise                 = [(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
      llambda :: Int
llambda      = 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. Num a => a -> a -> a
-Int
llambda) Int
0)
      coefficients :: [a]
coefficients = a -> [a]
forall a. a -> [a]
repeat a
forall a. C a => a
AlgRing.one

-- | Checks whether a spray defines a symmetric polynomial; this is useless for 

-- Jack polynomials because they always are symmetric, but this module contains 

-- everything needed to build this function which can be useful in another context

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

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

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

msCombination' :: AlgRing.C a => Spray a -> [(Partition, a)]
msCombination' :: forall a. C a => Spray a -> [(Partition, a)]
msCombination' Spray a
spray = 
  (Partition -> (Partition, a)) -> [Partition] -> [(Partition, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Partition
lambda -> (Partition
lambda, Partition -> Spray a -> a
forall a. C a => Partition -> Spray a -> a
getCoefficient Partition
lambda Spray a
spray)) [Partition]
lambdas
  where
    lambdas :: [Partition]
lambdas = [Partition] -> [Partition]
forall a. Eq a => [a] -> [a]
nub ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ ((Partition, a) -> Partition) -> [(Partition, a)] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map (Partition -> Partition
fromPartition (Partition -> Partition)
-> ((Partition, a) -> Partition) -> (Partition, a) -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> Partition
mkPartition (Partition -> Partition)
-> ((Partition, a) -> Partition) -> (Partition, a) -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition, a) -> Partition
forall a b. (a, b) -> a
fst) (Spray a -> [(Partition, a)]
forall a. Spray a -> [(Partition, a)]
toList Spray a
spray)

-- helper function for the showing stuff

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

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

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

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

--

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

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

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

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

--

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

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

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

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

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

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

-- symmetric polynomials

--

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

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

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

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

-- neither symmetry and homogeneity are checked

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

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

-- neither symmetry and homogeneity are checked

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

-- | Power sum polynomial

--

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

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

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

  -> Partition -- ^ integer partition

  -> Spray a
psPolynomial :: forall a. (C a, Eq a) => Int -> Partition -> Spray a
psPolynomial Int
n Partition
lambda
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"psPolynomial: negative number of variables."
  | Bool -> Bool
not (Partition -> Bool
_isPartition Partition
lambda) = 
      [Char] -> Spray a
forall a. HasCallStack => [Char] -> a
error [Char]
"psPolynomial: invalid partition."
  | Partition -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
lambda'              = Spray a
forall a. C a => Spray a
unitSpray
  | Int
llambda Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n               = Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise                 = [Spray a] -> Spray a
forall a. (Eq a, C a) => [Spray a] -> Spray a
productOfSprays [Spray a]
sprays
    where
      lambda' :: Partition
lambda' = Partition -> Partition
fromPartition (Partition -> Partition) -> Partition -> Partition
forall a b. (a -> b) -> a -> b
$ Partition -> Partition
mkPartition Partition
lambda
      llambda :: Int
llambda = Partition -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda'
      sprays :: [Spray a]
sprays = [[(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Powers, a)] -> Spray a) -> [(Powers, a)] -> Spray a
forall a b. (a -> b) -> a -> b
$ [Int -> Int -> (Powers, a)
forall {b}. C b => Int -> Int -> (Powers, b)
f Int
i Int
k | Int
i <- [Int
1 .. Int
n]] | Int
k <- Partition
lambda']
      f :: Int -> Int -> (Powers, b)
f Int
j Int
k = (Seq Int -> Int -> Powers
Powers Seq Int
expts Int
j, b
forall a. C a => a
AlgRing.one)
        where
          expts :: Seq Int
expts = Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0 Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
k

-- | monomial symmetric polynomial as a linear combination of 

-- power sum polynomials

mspInPSbasis :: Partition -> Map Partition Rational
mspInPSbasis :: Partition -> Map Partition Rational
mspInPSbasis Partition
kappa = [(Partition, Rational)] -> Map Partition Rational
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ((Rational -> Partition -> (Partition, Rational))
-> [Rational] -> [Partition] -> [(Partition, Rational)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rational -> Partition -> (Partition, Rational)
f [Rational]
weights [Partition]
lambdas)
  where
    parts :: [Partition]
parts = (Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
fromPartition (Int -> [Partition]
partitions (Partition -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
kappa))
    ([Rational]
weights, [Partition]
lambdas) = [(Rational, Partition)] -> ([Rational], [Partition])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Rational, Partition)] -> ([Rational], [Partition]))
-> [(Rational, Partition)] -> ([Rational], [Partition])
forall a b. (a -> b) -> a -> b
$ ((Rational, Partition) -> Bool)
-> [(Rational, Partition)] -> [(Rational, Partition)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0) (Rational -> Bool)
-> ((Rational, Partition) -> Rational)
-> (Rational, Partition)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, Partition) -> Rational
forall a b. (a, b) -> a
fst) 
      [(Partition -> Partition -> Rational
eLambdaMu Partition
kappa Partition
lambda, Partition
lambda) | Partition
lambda <- [Partition]
parts]
    f :: Rational -> Partition -> (Partition, Rational)
f Rational
weight Partition
lambda = 
      (Partition
lambda, Rational
weight Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a. Real a => a -> Rational
toRational (Partition -> Int
zlambda Partition
lambda))
    ----

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

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

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

-- | the factor in the Hall inner product

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

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

_psCombination :: 
  forall a. (Eq a, AlgRing.C a) => (a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination :: forall a.
(Eq a, C a) =>
(a -> Rational -> a) -> Spray a -> Map Partition a
_psCombination a -> Rational -> a
func Spray a
spray =
  if a
constantTerm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero 
    then Map Partition a
psMap
    else Partition -> a -> Map Partition a -> Map Partition a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [] a
constantTerm Map Partition a
psMap
  where
    constantTerm :: a
constantTerm = Spray a -> a
forall a. C a => Spray a -> a
getConstantTerm Spray a
spray
    assocs :: [(Partition, a)]
assocs = Spray a -> [(Partition, a)]
forall a. C a => Spray a -> [(Partition, a)]
msCombination' (Spray a
spray Spray a -> BaseRing (Spray a) -> Spray a
forall b. FunctionLike b => b -> BaseRing b -> b
<+ (a -> a
forall a. C a => a -> a
AlgAdd.negate a
constantTerm))
    f :: (Partition, a) -> [(Partition, a)] 
    f :: (Partition, a) -> [(Partition, a)]
f (Partition
lambda, a
coeff) = 
      ((Partition, Rational) -> (Partition, a))
-> [(Partition, Rational)] -> [(Partition, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> a) -> (Partition, Rational) -> (Partition, a)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (a -> Rational -> a
func a
coeff)) (Map Partition Rational -> [(Partition, Rational)]
forall k a. Map k a -> [(k, a)]
DM.toList Map Partition Rational
psCombo)
      where
        psCombo :: Map Partition Rational
psCombo = Partition -> Map Partition Rational
mspInPSbasis Partition
lambda :: Map Partition Rational
    psMap :: Map Partition a
psMap = (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) 
            ((a -> a -> a) -> [Map Partition a] -> Map Partition a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
unionsWith a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) (((Partition, a) -> Map Partition a)
-> [(Partition, a)] -> [Map Partition a]
forall a b. (a -> b) -> [a] -> [b]
map ([(Partition, a)] -> Map Partition a
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ([(Partition, a)] -> Map Partition a)
-> ((Partition, a) -> [(Partition, a)])
-> (Partition, a)
-> Map Partition a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Partition, a) -> [(Partition, a)]
f) [(Partition, a)]
assocs))

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

-- Symmetry is not checked.

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

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

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

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

-- | the Hall inner product with parameter

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

  -> Spray b   -- ^ spray

  -> a         -- ^ parameter

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

-- | Hall inner product with parameter. It makes sense only for symmetric sprays,

-- and the symmetry is not checked. 

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

  -> Spray a   -- ^ spray

  -> a         -- ^ parameter

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

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

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

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

  -> Spray a   -- ^ spray

  -> a         -- ^ parameter

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

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

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

-- to @Spray Int@ sprays.

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

  -> Spray a   -- ^ spray

  -> a         -- ^ parameter

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

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

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

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

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

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

--

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

-- >>> import Math.Algebra.JackSymbolicPol

-- >>> import Math.Algebra.Hspray

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

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

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

  -> Spray b    -- ^ parametric spray

  -> BaseRing b -- ^ parameter

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

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

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

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

-- is not.

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

  -> Spray b    -- ^ parametric spray

  -> BaseRing b -- ^ parameter

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

-- | the Hall inner product with symbolic parameter

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

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

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

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

-- but with other type constraints.

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

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

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

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


-- test'' :: (String, String)

-- test'' = (prettyParametricQSpray result, prettyParametricQSprayABCXYZ ["a"] ["b"] $ result)

--   where 

--     jsp = jackSymbolicPol' 3 [2, 1] 'P'

--     result = hallSymbolic'' jsp jsp