{-# LANGUAGE BangPatterns #-}
module Math.Algebra.Jack.Internal
  where
import qualified Algebra.Ring    as AR
import           Data.List.Index ( iconcatMap )

type Partition = [Int]

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

_diffSequence :: [Int] -> [Int]
_diffSequence :: Partition -> Partition
_diffSequence = forall {a}. Num a => [a] -> [a]
go where
  go :: [a] -> [a]
go (a
x:ys :: [a]
ys@(a
y:[a]
_)) = (a
xforall a. Num a => a -> a -> a
-a
y) 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 = forall {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
iforall a. Num a => a -> a -> a
+t
1) Partition
ds (Int
dforall a. a -> [a] -> [a]
:Partition
acc)
  go t
n  []     Partition
acc = forall {t}. Num t => t -> Partition -> [t]
finish t
n Partition
acc 
  finish :: t -> Partition -> [t]
finish !t
j (Int
k:Partition
ks) = forall a. Int -> a -> [a]
replicate Int
k t
j forall a. [a] -> [a] -> [a]
++ t -> Partition -> [t]
finish (t
jforall a. Num a => a -> a -> a
-t
1) Partition
ks
  finish t
_  []     = []

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

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

_N :: [Int] -> [Int] -> Int
_N :: Partition -> Partition -> Int
_N Partition
lambda Partition
mu = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(*) Partition
mu Partition
prods
  where
  prods :: Partition
prods = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
i (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+Int
1) Partition
lambda)) [Int
1 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length Partition
lambda]

hookLengths :: Fractional a => Partition -> a -> [a]
hookLengths :: forall a. Fractional a => Partition -> a -> [a]
hookLengths Partition
lambda a
alpha = [a]
upper forall a. [a] -> [a] -> [a]
++ [a]
lower
  where
    (Partition
i, Partition
j) = Partition -> (Partition, Partition)
_ij Partition
lambda
    ([a]
lambda', [a]
lambdaConj') = forall b. Num b => Partition -> ([b], [b])
_convParts Partition
lambda
    upper :: [a]
upper = 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]
xforall a. [a] -> Int -> a
!!(Int
jjforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ii forall a. Num a => a -> a -> a
+ a
alpha forall a. Num a => a -> a -> a
* ([a]
yforall a. [a] -> Int -> a
!!(Int
iiforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jj forall a. Num a => a -> a -> a
+ a
1)
    lower :: [a]
lower = 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]
xforall a. [a] -> Int -> a
!!(Int
jjforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ii forall a. Num a => a -> a -> a
+ a
1 forall a. Num a => a -> a -> a
+ a
alpha forall a. Num a => a -> a -> a
* ([a]
yforall a. [a] -> Int -> a
!!(Int
iiforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jj)

hookLengths' :: (Fractional a, AR.C a) => Partition -> a -> [a]
hookLengths' :: forall a. (Fractional a, C a) => Partition -> a -> [a]
hookLengths' = forall a. Fractional a => Partition -> a -> [a]
hookLengths

_betaratio :: Fractional a => Partition -> Partition -> Int -> a -> a
_betaratio :: forall a. Fractional a => Partition -> Partition -> Int -> a -> a
_betaratio Partition
kappa Partition
mu Int
k a
alpha = a
alpha forall a. Num a => a -> a -> a
* a
prod1 forall a. Num a => a -> a -> a
* a
prod2 forall a. Num a => a -> a -> a
* a
prod3
  where
    mukm1 :: Int
mukm1 = Partition
mu forall a. [a] -> Int -> a
!! (Int
kforall a. Num a => a -> a -> a
-Int
1)
    t :: a
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k forall a. Num a => a -> a -> a
- a
alpha forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mukm1
    u :: [a]
u = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
s Int
kap -> a
t forall a. Num a => a -> a -> a
+ a
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s forall a. Num a => a -> a -> a
+ a
alpha forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
kap)
                [Int
1 .. Int
k] Partition
kappa 
    v :: [a]
v = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
s Int
m -> a
t forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s forall a. Num a => a -> a -> a
+ a
alpha forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
                [Int
1 .. Int
kforall a. Num a => a -> a -> a
-Int
1] Partition
mu 
    w :: [a]
w = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
s Int
m -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
- a
t forall a. Num a => a -> a -> a
- a
alpha forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
                [Int
1 .. Int
mukm1forall a. Num a => a -> a -> a
-Int
1] (Partition -> Partition
_dualPartition Partition
mu)
    prod1 :: a
prod1 = 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 (\a
x -> a
x forall a. Fractional a => a -> a -> a
/ (a
x forall a. Num a => a -> a -> a
+ a
alpha forall a. Num a => a -> a -> a
- a
1)) [a]
u
    prod2 :: a
prod2 = 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 (\a
x -> (a
x forall a. Num a => a -> a -> a
+ a
alpha) forall a. Fractional a => a -> a -> a
/ a
x) [a]
v
    prod3 :: a
prod3 = 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 (\a
x -> (a
x forall a. Num a => a -> a -> a
+ a
alpha) forall a. Fractional a => a -> a -> a
/ a
x) [a]
w

_betaratio' :: (Fractional a, AR.C a) => [Int] -> [Int] -> Int -> a -> a
_betaratio' :: forall a.
(Fractional a, C a) =>
Partition -> Partition -> Int -> a -> a
_betaratio' = forall a. Fractional a => Partition -> Partition -> Int -> a -> a
_betaratio