module Numeric.Integration.Simplex.Simplex
  where
import Data.Matrix (detLU, elementwiseUnsafe, fromLists)

type Simplex = [[Double]]
type Simplices = [Simplex]

isValidSimplex :: Simplex -> Bool
isValidSimplex :: Simplex -> Bool
isValidSimplex Simplex
simplex =
  (forall (t :: * -> *) a. Foldable t => t a -> Int
length Simplex
simplex forall a. Eq a => a -> a -> Bool
== Int
dim forall a. Num a => a -> a -> a
+ Int
1) Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== Int
dim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) (forall a. [a] -> [a]
tail Simplex
simplex)
  where dim :: Int
dim = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. [a] -> a
head Simplex
simplex)

isValidSimplices :: Simplices -> Bool
isValidSimplices :: Simplices -> Bool
isValidSimplices Simplices
simplices =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Simplex -> Bool
isValidSimplex Simplices
simplices Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== forall {t :: * -> *} {a}. Foldable t => [t a] -> Int
spaceDim (forall a. [a] -> a
head Simplices
simplices)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {a}. Foldable t => [t a] -> Int
spaceDim) (forall a. [a] -> [a]
tail Simplices
simplices)
  where spaceDim :: [t a] -> Int
spaceDim [t a]
simplex = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. [a] -> a
head [t a]
simplex)

canonicalSimplex :: Int -> Simplex
canonicalSimplex :: Int -> Simplex
canonicalSimplex Int
dim =
  forall a. Int -> a -> [a]
replicate Int
dim Double
0 forall a. a -> [a] -> [a]
:
    forall a b. (a -> b) -> [a] -> [b]
map (\Int
v -> forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => a -> Int
fromEnumforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Eq a => a -> a -> Bool
== Int
v)) [Int
1..Int
dim]) [Int
1..Int
dim]

simplexVolume :: Simplex -> Double -- rq: tu calcules le fact à chaque fois
simplexVolume :: Simplex -> Double
simplexVolume Simplex
s = forall a. Num a => a -> a
abs (forall a. (Ord a, Fractional a) => Matrix a -> a
detLU Matrix Double
v) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int
1..Int
n])
  where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length Simplex
s forall a. Num a => a -> a -> a
- Int
1
        m1 :: Matrix Double
m1 = forall a. [[a]] -> Matrix a
fromLists (forall a. [a] -> [a]
tail Simplex
s)
        m2 :: Matrix Double
m2 = forall a. [[a]] -> Matrix a
fromLists forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
n (forall a. [a] -> a
head Simplex
s)
        v :: Matrix Double
v = forall a b c. (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
elementwiseUnsafe (-) Matrix Double
m1 Matrix Double
m2

jacobian :: Simplex -> Double -- not used
jacobian :: Simplex -> Double
jacobian Simplex
s = forall a. Num a => a -> a
abs (forall a. (Ord a, Fractional a) => Matrix a -> a
detLU (forall a b c. (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
elementwiseUnsafe (-) Matrix Double
m1 Matrix Double
m2))
  where m1 :: Matrix Double
m1 = forall a. [[a]] -> Matrix a
fromLists (forall a. [a] -> [a]
tail Simplex
s)
        m2 :: Matrix Double
m2 = forall a. [[a]] -> Matrix a
fromLists forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length Simplex
s forall a. Num a => a -> a -> a
- Int
1) (forall a. [a] -> a
head Simplex
s)