{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Math.HypergeoMatrix.Internal where
import           Data.Complex
import           Data.Ratio
import           Data.Maybe
import           Data.Sequence       (Seq ((:<|), (:|>), Empty), elemIndexL,
                                      index, (!?), (><), (|>))
import qualified Data.Sequence       as S
import           Math.HypergeoMatrix.Gaussian

class BaseFrac a where
  type family BaseFracType a
  type BaseFracType a = a -- Default type family instance (unless overridden)
  inject :: BaseFracType a -> a
  default inject :: BaseFracType a ~ a => BaseFracType a -> a
  inject = forall a. a -> a
id

instance Integral a => BaseFrac (Ratio a)
instance BaseFrac Float
instance BaseFrac Double
instance BaseFrac GaussianRational where
  type BaseFracType GaussianRational = Rational
  inject :: BaseFracType GaussianRational -> GaussianRational
inject BaseFracType GaussianRational
x = BaseFracType GaussianRational
x Rational -> Rational -> GaussianRational
+: Rational
0
instance Num a => BaseFrac (Complex a) where
  type BaseFracType (Complex a) = a
  inject :: BaseFracType (Complex a) -> Complex a
inject BaseFracType (Complex a)
x = BaseFracType (Complex a)
x forall a. a -> a -> Complex a
:+ a
0

_diffSequence :: Seq Int -> Seq Int
_diffSequence :: Seq Int -> Seq Int
_diffSequence (Int
x :<| ys :: Seq Int
ys@(Int
y :<| Seq Int
_)) = (Int
x forall a. Num a => a -> a -> a
- Int
y) forall a. a -> Seq a -> Seq a
:<| Seq Int -> Seq Int
_diffSequence Seq Int
ys
_diffSequence Seq Int
x                    = Seq Int
x

_dualPartition :: Seq Int -> Seq Int
_dualPartition :: Seq Int -> Seq Int
_dualPartition Seq Int
Empty = forall a. Seq a
S.empty
_dualPartition Seq Int
xs = forall {t}. Num t => t -> Seq Int -> Seq Int -> Seq t
go Int
0 (Seq Int -> Seq Int
_diffSequence Seq Int
xs) forall a. Seq a
S.empty
  where
    go :: t -> Seq Int -> Seq Int -> Seq t
go !t
i (Int
d :<| Seq Int
ds) Seq Int
acc = t -> Seq Int -> Seq Int -> Seq t
go (t
i forall a. Num a => a -> a -> a
+ t
1) Seq Int
ds (Int
d forall a. a -> Seq a -> Seq a
:<| Seq Int
acc)
    go t
n Seq Int
Empty Seq Int
acc       = forall {t}. Num t => t -> Seq Int -> Seq t
finish t
n Seq Int
acc
    finish :: t -> Seq Int -> Seq t
finish !t
j (Int
k :<| Seq Int
ks) = forall a. Int -> a -> Seq a
S.replicate Int
k t
j forall a. Seq a -> Seq a -> Seq a
>< t -> Seq Int -> Seq t
finish (t
j forall a. Num a => a -> a -> a
- t
1) Seq Int
ks
    finish t
_ Seq Int
Empty       = forall a. Seq a
S.empty

_betaratio :: (Fractional a, BaseFrac a)
  => Seq Int -> Seq Int -> Int -> BaseFracType a -> a
_betaratio :: forall a.
(Fractional a, BaseFrac a) =>
Seq Int -> Seq Int -> Int -> BaseFracType a -> a
_betaratio Seq Int
kappa Seq Int
mu Int
k BaseFracType 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
    alpha' :: a
alpha' = forall a. BaseFrac a => BaseFracType a -> a
inject BaseFracType a
alpha
    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 (Seq Int
mu forall a. Seq a -> Int -> a
`index` (Int
k forall a. Num a => a -> a -> a
- Int
1))
    ss :: Seq Int
ss = forall a. [a] -> Seq a
S.fromList [Int
1 .. Int
k forall a. Num a => a -> a -> a
- Int
1]
    sss :: Seq Int
sss = Seq Int
ss forall a. Seq a -> a -> Seq a
|> Int
k
    u :: Seq a
u =
      forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.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)
        Seq Int
sss (forall a. Int -> Seq a -> Seq a
S.take Int
k Seq Int
kappa)
    v :: Seq a
v =
      forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.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)
        Seq Int
ss (forall a. Int -> Seq a -> Seq a
S.take (Int
k forall a. Num a => a -> a -> a
- Int
1) Seq Int
mu)
    l :: Int
l = Seq Int
mu forall a. Seq a -> Int -> a
`index` (Int
k forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
- Int
1
    mu' :: Seq Int
mu' = forall a. Int -> Seq a -> Seq a
S.take Int
l (Seq Int -> Seq Int
_dualPartition Seq Int
mu)
    w :: Seq a
w =
      forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.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)
        (forall a. [a] -> Seq a
S.fromList [Int
1 .. Int
l]) Seq Int
mu'
    prod1 :: a
prod1 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\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)) Seq a
u
    prod2 :: a
prod2 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x forall a. Num a => a -> a -> a
+ a
alpha') forall a. Fractional a => a -> a -> a
/ a
x) Seq a
v
    prod3 :: a
prod3 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x forall a. Num a => a -> a -> a
+ a
alpha') forall a. Fractional a => a -> a -> a
/ a
x) Seq a
w


_T :: (Fractional a, Eq a, BaseFrac a)
   => BaseFracType a -> [a] -> [a] -> Seq Int -> a
_T :: forall a.
(Fractional a, Eq a, BaseFrac a) =>
BaseFracType a -> [a] -> [a] -> Seq Int -> a
_T BaseFracType a
alpha [a]
a [a]
b Seq Int
kappa
  | forall a. Seq a -> Bool
S.null Seq Int
kappa Bool -> Bool -> Bool
|| Seq Int
kappa forall a. Seq a -> Int -> Maybe a
!? Int
0 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0 = a
1
  | a
prod1_den forall a. Eq a => a -> a -> Bool
== a
0 = a
0
  | Bool
otherwise = a
prod1_numforall a. Fractional a => a -> a -> a
/a
prod1_den forall a. Num a => a -> a -> a
* a
prod2 forall a. Num a => a -> a -> a
* a
prod3
  where
    alpha' :: a
alpha' = forall a. BaseFrac a => BaseFracType a -> a
inject BaseFracType a
alpha
    lkappa :: Int
lkappa = forall a. Seq a -> Int
S.length Seq Int
kappa forall a. Num a => a -> a -> a
- Int
1
    kappai :: Int
kappai = Seq Int
kappa forall a. Seq a -> Int -> a
`index` Int
lkappa
    kappai' :: a
kappai' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
kappai
    i :: a
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lkappa
    c :: a
c = a
kappai' forall a. Num a => a -> a -> a
- a
1 forall a. Num a => a -> a -> a
- a
i forall a. Fractional a => a -> a -> a
/ a
alpha'
    d :: a
d = a
kappai' forall a. Num a => a -> a -> a
* a
alpha' forall a. Num a => a -> a -> a
- a
i forall a. Num a => a -> a -> a
- a
1
    s :: Seq a
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. [a] -> Seq a
S.fromList [Int
1 .. Int
kappai forall a. Num a => a -> a -> a
- Int
1])
    kappa' :: Seq a
kappa' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Seq a -> Seq a
S.take Int
kappai (Seq Int -> Seq Int
_dualPartition Seq Int
kappa)
    e :: Seq a
e = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (\a
x a
y -> a
d forall a. Num a => a -> a -> a
- a
x forall a. Num a => a -> a -> a
* a
alpha' forall a. Num a => a -> a -> a
+ a
y) Seq a
s Seq a
kappa'
    g :: Seq a
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ a
1) Seq a
e
    s' :: Seq a
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. [a] -> Seq a
S.fromList [Int
1 .. Int
lkappa])
    f :: Seq a
f = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (\a
x a
y -> a
y forall a. Num a => a -> a -> a
* a
alpha' forall a. Num a => a -> a -> a
- a
x forall a. Num a => a -> a -> a
- a
d) Seq a
s' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Seq Int
kappa)
    h :: Seq a
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ a
alpha') Seq a
f
    l :: Seq a
l = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith forall a. Num a => a -> a -> a
(*) Seq a
h Seq a
f
    prod1_num :: a
prod1_num = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ a
c) [a]
a)
    prod1_den :: a
prod1_den = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ a
c) [a]
b)
    prod2 :: a
prod2 =
      forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (\a
x a
y -> (a
y forall a. Num a => a -> a -> a
- a
alpha') forall a. Num a => a -> a -> a
* a
x forall a. Fractional a => a -> a -> a
/ a
y forall a. Fractional a => a -> a -> a
/ (a
x forall a. Num a => a -> a -> a
+ a
alpha')) Seq a
e Seq a
g
    prod3 :: a
prod3 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
S.zipWith3 (\a
x a
y a
z -> (a
z forall a. Num a => a -> a -> a
- a
x) forall a. Fractional a => a -> a -> a
/ (a
z forall a. Num a => a -> a -> a
+ a
y)) Seq a
f Seq a
h Seq a
l

a008284 :: [[Int]]
a008284 :: [[Int]]
a008284 = [Int
1] forall a. a -> [a] -> [a]
: forall {a}. Num a => [[a]] -> [[a]]
f [[Int
1]]
  where
    f :: [[a]] -> [[a]]
f [[a]]
xss = [a]
ys forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
f ([a]
ys forall a. a -> [a] -> [a]
: [[a]]
xss)
      where
        ys :: [a]
ys = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int -> [a] -> [a]
take [Int
1 ..] [[a]]
xss) forall a. [a] -> [a] -> [a]
++ [a
1]

_P :: Int -> Int -> Int
_P :: Int -> Int -> Int
_P Int
m Int
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take (forall a. Ord a => a -> a -> a
min Int
m Int
n)) (forall a. Int -> [a] -> [a]
take Int
m [[Int]]
a008284))

_dico :: Int -> Int -> Seq (Maybe Int)
_dico :: Int -> Int -> Seq (Maybe Int)
_dico Int
pmn Int
m = Bool -> Seq (Maybe Int) -> Seq (Maybe Int)
go Bool
False forall a. Seq a
S.empty
  where
    go :: Bool -> Seq (Maybe Int) -> Seq (Maybe Int)
    go :: Bool -> Seq (Maybe Int) -> Seq (Maybe Int)
go Bool
k !Seq (Maybe Int)
d'
      | Bool
k = Seq (Maybe Int)
d'
      | Bool
otherwise = Int
-> [Int]
-> [Int]
-> [Int]
-> Int
-> Seq (Maybe Int)
-> Maybe Int
-> Seq (Maybe Int)
inner Int
0 [Int
0] [Int
m] [Int
m] Int
0 Seq (Maybe Int)
d' forall a. Maybe a
Nothing
      where
        inner :: Int -> [Int] -> [Int] -> [Int] -> Int
              -> Seq (Maybe Int) -> Maybe Int -> Seq (Maybe Int)
        inner :: Int
-> [Int]
-> [Int]
-> [Int]
-> Int
-> Seq (Maybe Int)
-> Maybe Int
-> Seq (Maybe Int)
inner Int
i ![Int]
a ![Int]
b ![Int]
c !Int
end !Seq (Maybe Int)
d !Maybe Int
dlast
          | Maybe Int
dlast forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
pmn = Bool -> Seq (Maybe Int) -> Seq (Maybe Int)
go Bool
True Seq (Maybe Int)
d
          | Bool
otherwise =
            let bi :: Int
bi = [Int]
b forall a. [a] -> Int -> a
!! Int
i
            in if Int
bi forall a. Ord a => a -> a -> Bool
> Int
0
                 then let l :: Int
l = forall a. Ord a => a -> a -> a
min Int
bi ([Int]
c forall a. [a] -> Int -> a
!! Int
i)
                      in let ddlast :: Maybe Int
ddlast = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
end forall a. Num a => a -> a -> a
+ Int
1
                         in let dd :: Seq (Maybe Int)
dd = Seq (Maybe Int)
d forall a. Seq a -> a -> Seq a
|> Maybe Int
ddlast
                            in let range1l :: [Int]
range1l = [Int
1 .. Int
l]
                               in Int
-> [Int]
-> [Int]
-> [Int]
-> Int
-> Seq (Maybe Int)
-> Maybe Int
-> Seq (Maybe Int)
inner
                                    (Int
i forall a. Num a => a -> a -> a
+ Int
1)
                                    ([Int]
a forall a. [a] -> [a] -> [a]
++ [Int
end forall a. Num a => a -> a -> a
+ Int
1 .. Int
end forall a. Num a => a -> a -> a
+ Int
l])
                                    ([Int]
b forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Int
bi forall a. Num a => a -> a -> a
-) [Int]
range1l)
                                    ([Int]
c forall a. [a] -> [a] -> [a]
++ [Int]
range1l)
                                    (Int
end forall a. Num a => a -> a -> a
+ Int
l)
                                    Seq (Maybe Int)
dd
                                    Maybe Int
ddlast
                 else Int
-> [Int]
-> [Int]
-> [Int]
-> Int
-> Seq (Maybe Int)
-> Maybe Int
-> Seq (Maybe Int)
inner (Int
i forall a. Num a => a -> a -> a
+ Int
1) [Int]
a [Int]
b [Int]
c Int
end (Seq (Maybe Int)
d forall a. Seq a -> a -> Seq a
|> forall a. Maybe a
Nothing) forall a. Maybe a
Nothing

_nkappa :: Seq (Maybe Int) -> Seq Int -> Int
_nkappa :: Seq (Maybe Int) -> Seq Int -> Int
_nkappa Seq (Maybe Int)
dico (Seq Int
kappa0 :|> Int
kappan) =
  forall a. HasCallStack => Maybe a -> a
fromJust (Seq (Maybe Int)
dico forall a. Seq a -> Int -> a
`S.index` Seq (Maybe Int) -> Seq Int -> Int
_nkappa Seq (Maybe Int)
dico Seq Int
kappa0) forall a. Num a => a -> a -> a
+ Int
kappan forall a. Num a => a -> a -> a
- Int
1
_nkappa Seq (Maybe Int)
_ Seq Int
Empty = Int
0

cleanPart :: Seq Int -> Seq Int
cleanPart :: Seq Int -> Seq Int
cleanPart Seq Int
kappa =
  let i :: Maybe Int
i = forall a. Eq a => a -> Seq a -> Maybe Int
elemIndexL Int
0 Seq Int
kappa
  in if forall a. Maybe a -> Bool
isJust Maybe Int
i
       then forall a. Int -> Seq a -> Seq a
S.take (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
i) Seq Int
kappa
       else Seq Int
kappa