{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Math.Algebra.Jack
  (schur, jack, zonal)
  where
import Control.Lens               ( (.~), element )
import Data.Array                 ( Array, (!), (//), listArray )
import Data.Maybe                 ( fromJust, isJust )
import Math.Algebra.Jack.Internal ( _N, hookLengths, _betaratio, _isPartition, Partition )
import Numeric.SpecFunctions      ( factorial )

-- | Evaluation of Jack polynomial
jack :: forall a. (Fractional a, Ord a) 
  => [a] -- ^ values of the variables
  -> Partition -- ^ partition of integers
  -> a -- ^ alpha parameter
  -> a
jack :: forall a. (Fractional a, Ord a) => [a] -> Partition -> a -> a
jack [a]
x Partition
lambda a
alpha =
  case Partition -> Bool
_isPartition Partition
lambda Bool -> Bool -> Bool
&& a
alpha forall a. Ord a => a -> a -> Bool
> a
0 of
    Bool
False -> if Partition -> Bool
_isPartition Partition
lambda
      then forall a. HasCallStack => [Char] -> a
error [Char]
"alpha must be strictly positive"
      else forall a. HasCallStack => [Char] -> a
error [Char]
"lambda is not a valid integer partition"
    Bool
True -> Int
-> Int
-> Partition
-> Partition
-> Array (Int, Int) (Maybe a)
-> a
-> a
jac (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x) Int
0 Partition
lambda Partition
lambda forall {a}. Array (Int, Int) (Maybe a)
arr0 a
1
      where
      nll :: Int
nll = Partition -> Partition -> Int
_N Partition
lambda Partition
lambda
      n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x
      arr0 :: Array (Int, Int) (Maybe a)
arr0 = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1, Int
1), (Int
nll, Int
n)) (forall a. Int -> a -> [a]
replicate (Int
nll forall a. Num a => a -> a -> a
* Int
n) forall a. Maybe a
Nothing)
      theproduct :: Int -> a
      theproduct :: Int -> a
theproduct Int
nu0 = if Int
nu0 forall a. Ord a => a -> a -> Bool
<= Int
1
        then a
1
        else forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> a
alpha forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
+ a
1) [Int
1 .. Int
nu0forall a. Num a => a -> a -> a
-Int
1]
      jac :: Int -> Int -> [Int] -> [Int] -> Array (Int,Int) (Maybe a) -> a -> a
      jac :: Int
-> Int
-> Partition
-> Partition
-> Array (Int, Int) (Maybe a)
-> a
-> a
jac Int
m Int
k Partition
mu Partition
nu Array (Int, Int) (Maybe a)
arr a
beta
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
nu Bool -> Bool -> Bool
|| forall a. [a] -> a
head Partition
nu forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
m forall a. Eq a => a -> a -> Bool
== Int
0 = a
1
        | forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu forall a. Ord a => a -> a -> Bool
> Int
m Bool -> Bool -> Bool
&& Partition
nuforall a. [a] -> Int -> a
!!Int
m forall a. Ord a => a -> a -> Bool
> Int
0 = a
0
        | Int
m forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. [a] -> a
head [a]
x forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. [a] -> a
head Partition
nu forall a. Num a => a -> a -> a
* Int -> a
theproduct (forall a. [a] -> a
head Partition
nu)
        | Int
k forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (Array (Int, Int) (Maybe a)
arr forall i e. Ix i => Array i e -> i -> e
! (Partition -> Partition -> Int
_N Partition
lambda Partition
nu, Int
m)) =
                      forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Array (Int, Int) (Maybe a)
arr forall i e. Ix i => Array i e -> i -> e
! (Partition -> Partition -> Int
_N Partition
lambda Partition
nu, Int
m)
        | Bool
otherwise = a
s
          where
            s :: a
s = a -> Int -> a
go (Int
-> Int
-> Partition
-> Partition
-> Array (Int, Int) (Maybe a)
-> a
-> a
jac (Int
mforall a. Num a => a -> a -> a
-Int
1) Int
0 Partition
nu Partition
nu Array (Int, Int) (Maybe a)
arr a
1 forall a. Num a => a -> a -> a
* a
beta forall a. Num a => a -> a -> a
* [a]
xforall a. [a] -> Int -> a
!!(Int
mforall a. Num a => a -> a -> a
-Int
1) forall a b. (Num a, Integral b) => a -> b -> a
^ (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
nu))
                (forall a. Ord a => a -> a -> a
max Int
1 Int
k)
            go :: a -> Int -> a
            go :: a -> Int -> a
go !a
ss Int
ii
              | forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu forall a. Ord a => a -> a -> Bool
< Int
ii Bool -> Bool -> Bool
|| Partition
nuforall a. [a] -> Int -> a
!!(Int
iiforall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
== Int
0 = a
ss
              | Bool
otherwise =
                let u :: Int
u = Partition
nuforall a. [a] -> Int -> a
!!(Int
iiforall a. Num a => a -> a -> a
-Int
1) in
                if forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu forall a. Eq a => a -> a -> Bool
== Int
ii Bool -> Bool -> Bool
&& Int
u forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
u forall a. Ord a => a -> a -> Bool
> Partition
nuforall a. [a] -> Int -> a
!!Int
ii
                  then
                    let nu' :: Partition
nu' = (forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element (Int
iiforall a. Num a => a -> a -> a
-Int
1) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
uforall a. Num a => a -> a -> a
-Int
1) Partition
nu in
                    let gamma :: a
gamma = a
beta forall a. Num a => a -> a -> a
* forall a. Fractional a => Partition -> Partition -> Int -> a -> a
_betaratio Partition
mu Partition
nu Int
ii a
alpha in
                    if Int
u forall a. Ord a => a -> a -> Bool
> Int
1
                      then
                        a -> Int -> a
go (a
ss forall a. Num a => a -> a -> a
+ Int
-> Int
-> Partition
-> Partition
-> Array (Int, Int) (Maybe a)
-> a
-> a
jac Int
m Int
ii Partition
mu Partition
nu' Array (Int, Int) (Maybe a)
arr a
gamma) (Int
ii forall a. Num a => a -> a -> a
+ Int
1)
                      else
                        if forall a. [a] -> a
head Partition
nu' forall a. Eq a => a -> a -> Bool
== Int
0
                          then
                            a -> Int -> a
go (a
ss forall a. Num a => a -> a -> a
+ a
gamma forall a. Num a => a -> a -> a
* [a]
xforall a. [a] -> Int -> a
!!(Int
mforall a. Num a => a -> a -> a
-Int
1)forall a b. (Num a, Integral b) => a -> b -> a
^ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu) (Int
ii forall a. Num a => a -> a -> a
+ Int
1)
                          else
                            let arr' :: Array (Int, Int) (Maybe a)
arr' = Array (Int, Int) (Maybe a)
arr forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Partition -> Partition -> Int
_N Partition
lambda Partition
nu, Int
m), forall a. a -> Maybe a
Just a
ss)] in
                            let jck :: a
jck = Int
-> Int
-> Partition
-> Partition
-> Array (Int, Int) (Maybe a)
-> a
-> a
jac (Int
mforall a. Num a => a -> a -> a
-Int
1) Int
0 Partition
nu' Partition
nu' Array (Int, Int) (Maybe a)
arr' a
1 in
                            let jck' :: a
jck' = a
jck forall a. Num a => a -> a -> a
* a
gamma forall a. Num a => a -> a -> a
*
                                        [a]
xforall a. [a] -> Int -> a
!!(Int
mforall a. Num a => a -> a -> a
-Int
1) forall a b. (Num a, Integral b) => a -> b -> a
^ (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
mu forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
nu') in
                            a -> Int -> a
go (a
ssforall a. Num a => a -> a -> a
+a
jck') (Int
iiforall a. Num a => a -> a -> a
+Int
1)
                  else
                    a -> Int -> a
go a
ss (Int
iiforall a. Num a => a -> a -> a
+Int
1)

-- | Evaluation of zonal polynomial
zonal :: (Fractional a, Ord a) 
  => [a] -- ^ values of the variables
  -> Partition -- ^ partition of integers
  -> a
zonal :: forall a. (Fractional a, Ord a) => [a] -> Partition -> a
zonal [a]
x Partition
lambda = a
c forall a. Num a => a -> a -> a
* a
jck
  where
    k :: Int
k = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Partition
lambda
    jlambda :: a
jlambda = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (forall a. Fractional a => Partition -> a -> [a]
hookLengths Partition
lambda a
2)
    c :: a
c = a
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
k forall a. Num a => a -> a -> a
* forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int -> Double
factorial Int
k) forall a. Fractional a => a -> a -> a
/ a
jlambda
    jck :: a
jck = forall a. (Fractional a, Ord a) => [a] -> Partition -> a -> a
jack [a]
x Partition
lambda a
2

-- | Evaluation of Schur polynomial
schur :: forall a. Fractional a 
  => [a] -- ^ values of the variables
  -> Partition -- ^ partition of integers 
  -> a
schur :: forall a. Fractional a => [a] -> Partition -> a
schur [a]
x Partition
lambda =
  case Partition -> Bool
_isPartition Partition
lambda of
    Bool
False -> forall a. HasCallStack => [Char] -> a
error [Char]
"lambda is not a valid integer partition"
    Bool
True -> Int -> Int -> Partition -> Array (Int, Int) (Maybe a) -> a
sch Int
n Int
1 Partition
lambda forall {a}. Array (Int, Int) (Maybe a)
arr0
      where
        nll :: Int
nll = Partition -> Partition -> Int
_N Partition
lambda Partition
lambda
        n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x
        arr0 :: Array (Int, Int) (Maybe a)
arr0 = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1, Int
1), (Int
nll, Int
n)) (forall a. Int -> a -> [a]
replicate (Int
nll forall a. Num a => a -> a -> a
* Int
n) forall a. Maybe a
Nothing)
        sch :: Int -> Int -> [Int] -> Array (Int,Int) (Maybe a) -> a
        sch :: Int -> Int -> Partition -> Array (Int, Int) (Maybe a) -> a
sch Int
m Int
k Partition
nu Array (Int, Int) (Maybe a)
arr
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Partition
nu Bool -> Bool -> Bool
|| forall a. [a] -> a
head Partition
nu forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
m forall a. Eq a => a -> a -> Bool
== Int
0 = a
1
          | forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu forall a. Ord a => a -> a -> Bool
> Int
m Bool -> Bool -> Bool
&& Partition
nuforall a. [a] -> Int -> a
!!Int
m forall a. Ord a => a -> a -> Bool
> Int
0 = a
0
          | Int
m forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. [a] -> a
head [a]
x forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. [a] -> a
head Partition
nu
          | forall a. Maybe a -> Bool
isJust (Array (Int, Int) (Maybe a)
arr forall i e. Ix i => Array i e -> i -> e
! (Partition -> Partition -> Int
_N Partition
lambda Partition
nu, Int
m)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Array (Int, Int) (Maybe a)
arr forall i e. Ix i => Array i e -> i -> e
! (Partition -> Partition -> Int
_N Partition
lambda Partition
nu, Int
m)
          | Bool
otherwise = a
s
            where
              s :: a
s = Fractional a => a -> Int -> a
go (Int -> Int -> Partition -> Array (Int, Int) (Maybe a) -> a
sch (Int
mforall a. Num a => a -> a -> a
-Int
1) Int
1 Partition
nu Array (Int, Int) (Maybe a)
arr) Int
k
              go :: Fractional a => a -> Int -> a
              go :: Fractional a => a -> Int -> a
go !a
ss Int
ii
                | forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu forall a. Ord a => a -> a -> Bool
< Int
ii Bool -> Bool -> Bool
|| Partition
nuforall a. [a] -> Int -> a
!!(Int
iiforall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
== Int
0 = a
ss
                | Bool
otherwise =
                  let u :: Int
u = Partition
nuforall a. [a] -> Int -> a
!!(Int
iiforall a. Num a => a -> a -> a
-Int
1) in
                  if forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
nu forall a. Eq a => a -> a -> Bool
== Int
ii Bool -> Bool -> Bool
&& Int
u forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
u forall a. Ord a => a -> a -> Bool
> Partition
nu forall a. [a] -> Int -> a
!! Int
ii
                    then
                      let nu' :: Partition
nu' = (forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element (Int
iiforall a. Num a => a -> a -> a
-Int
1) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
uforall a. Num a => a -> a -> a
-Int
1) Partition
nu in
                      if Int
u forall a. Ord a => a -> a -> Bool
> Int
1
                        then
                          Fractional a => a -> Int -> a
go (a
ss forall a. Num a => a -> a -> a
+ [a]
xforall a. [a] -> Int -> a
!!(Int
mforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
* Int -> Int -> Partition -> Array (Int, Int) (Maybe a) -> a
sch Int
m Int
ii Partition
nu' Array (Int, Int) (Maybe a)
arr) (Int
ii forall a. Num a => a -> a -> a
+ Int
1)
                        else
                          if forall a. [a] -> a
head Partition
nu' forall a. Eq a => a -> a -> Bool
== Int
0
                            then
                              Fractional a => a -> Int -> a
go (a
ss forall a. Num a => a -> a -> a
+ [a]
xforall a. [a] -> Int -> a
!!(Int
mforall a. Num a => a -> a -> a
-Int
1)) (Int
ii forall a. Num a => a -> a -> a
+ Int
1)
                            else
                              let arr' :: Array (Int, Int) (Maybe a)
arr' = Array (Int, Int) (Maybe a)
arr forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Partition -> Partition -> Int
_N Partition
lambda Partition
nu, Int
m), forall a. a -> Maybe a
Just a
ss)] in
                              Fractional a => a -> Int -> a
go (a
ss forall a. Num a => a -> a -> a
+ [a]
xforall a. [a] -> Int -> a
!!(Int
mforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
* Int -> Int -> Partition -> Array (Int, Int) (Maybe a) -> a
sch (Int
mforall a. Num a => a -> a -> a
-Int
1) Int
1 Partition
nu' Array (Int, Int) (Maybe a)
arr') (Int
ii forall a. Num a => a -> a -> a
+ Int
1)
                    else
                      Fractional a => a -> Int -> a
go a
ss (Int
iiforall a. Num a => a -> a -> a
+Int
1)