module Numeric.Interpolation.Type (
   T(..),
   linear,
   hermite1,
   cubicLinear,
   cubicParabola,
   ) where

import qualified Numeric.Interpolation.NodeList as Nodes
import qualified Numeric.Interpolation.Piece as Piece
import qualified Numeric.Interpolation.Basis as Basis
import qualified Numeric.Interpolation.Sample as Sample
import Numeric.Interpolation.Private.Basis (hermite1Split)


{- $setup
>>> import qualified Numeric.Interpolation.Type as Type
>>>
>>> checkOverlap :: Type.T Double y ny -> [Double] -> Double -> Bool
>>> checkOverlap typ xs xi =
>>>    let samples = map fst $ Type.sampleBasisFunctions typ xs xi
>>>    in  all (< minimum samples + Type.basisOverlap typ) samples
>>>
>>> checkOverlapNotTotal :: Type.T Double y ny -> [Double] -> Double -> Bool
>>> checkOverlapNotTotal typ xs xi =
>>>    let samples = map fst $ Type.sampleBasisFunctions typ xs xi
>>>    in  maximum samples - minimum samples < Type.basisOverlap typ
-}


data T x y ny =
   Cons {
      T x y ny -> [x] -> [y] -> String
ssvFromNodes :: [x] -> [y] -> String,
      T x y ny -> T x y ny
interpolatePiece :: Piece.T x y ny,
      T x y ny -> Int
basisOverlap :: Int
         {- ^
         maximum difference of indices of basis functions that overlap plus one
         -},
      T x y ny -> [x] -> [T x ny]
basisFunctions :: [x] -> [Nodes.T x ny],
      T x y ny -> [x] -> x -> [(Int, y)]
sampleBasisFunctions :: [x] -> x -> [(Int, y)],
      T x y ny -> [x] -> [y] -> T x ny
coefficientsToInterpolator :: [x] -> [y] -> Nodes.T x ny,
      T x y ny -> ny -> y
valueFromNode :: ny -> y
   }

{- |
prop> checkOverlap Type.linear
-}
linear :: (Fractional a, Ord a, Show a) => T a a a
linear :: T a a a
linear =
   Cons :: forall x y ny.
([x] -> [y] -> String)
-> T x y ny
-> Int
-> ([x] -> [T x ny])
-> ([x] -> x -> [(Int, y)])
-> ([x] -> [y] -> T x ny)
-> (ny -> y)
-> T x y ny
Cons {
      ssvFromNodes :: [a] -> [a] -> String
ssvFromNodes =
         \[a]
xs [a]
ys -> [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> a -> String) -> [a] -> [a] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y) [a]
xs [a]
ys,
      interpolatePiece :: T a a a
interpolatePiece = T a a a
forall a. Fractional a => T a a a
Piece.linear,
      basisOverlap :: Int
basisOverlap = Int
2,
      basisFunctions :: [a] -> [T a a]
basisFunctions = [a] -> [T a a]
forall b a. Num b => [a] -> [T a b]
Basis.linear,
      sampleBasisFunctions :: [a] -> a -> [(Int, a)]
sampleBasisFunctions = [a] -> a -> [(Int, a)]
forall a. (Fractional a, Ord a) => T a a
Sample.linear,
      coefficientsToInterpolator :: [a] -> [a] -> T a a
coefficientsToInterpolator = [a] -> [a] -> T a a
forall a b. [a] -> [b] -> T a b
Basis.coefficientsToLinear,
      valueFromNode :: a -> a
valueFromNode = a -> a
forall a. a -> a
id
   }

{- |
prop> checkOverlap Type.hermite1
-}
hermite1 :: (Fractional a, Ord a, Show a) => T a a (a, a)
hermite1 :: T a a (a, a)
hermite1 =
   Cons :: forall x y ny.
([x] -> [y] -> String)
-> T x y ny
-> Int
-> ([x] -> [T x ny])
-> ([x] -> x -> [(Int, y)])
-> ([x] -> [y] -> T x ny)
-> (ny -> y)
-> T x y ny
Cons {
      ssvFromNodes :: [a] -> [a] -> String
ssvFromNodes =
         \[a]
xs [a]
ys ->
            [String] -> String
unlines ([String] -> String)
-> ([(a, a)] -> [String]) -> [(a, a)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (a -> (a, a) -> String) -> [a] -> [(a, a)] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x (a
y,a
dy) -> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
dy) [a]
xs ([(a, a)] -> String) -> [(a, a)] -> String
forall a b. (a -> b) -> a -> b
$
            [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(b, b)]
hermite1Split [a]
xs [a]
ys,
      interpolatePiece :: T a a (a, a)
interpolatePiece = T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1,
      basisOverlap :: Int
basisOverlap = Int
4,
      basisFunctions :: [a] -> [T a (a, a)]
basisFunctions = [a] -> [T a (a, a)]
forall b a. Num b => [a] -> [T a (b, b)]
Basis.hermite1,
      sampleBasisFunctions :: [a] -> a -> [(Int, a)]
sampleBasisFunctions = [a] -> a -> [(Int, a)]
forall a. (Fractional a, Ord a) => T a a
Sample.hermite1,
      coefficientsToInterpolator :: [a] -> [a] -> T a (a, a)
coefficientsToInterpolator = [a] -> [a] -> T a (a, a)
forall a b. [a] -> [b] -> T a (b, b)
Basis.coefficientsToHermite1,
      valueFromNode :: (a, a) -> a
valueFromNode = (a, a) -> a
forall a b. (a, b) -> a
fst
   }

{- |
prop> checkOverlap Type.cubicLinear
-}
cubicLinear :: (Fractional a, Ord a, Show a) => T a a (a, a)
cubicLinear :: T a a (a, a)
cubicLinear =
   Cons :: forall x y ny.
([x] -> [y] -> String)
-> T x y ny
-> Int
-> ([x] -> [T x ny])
-> ([x] -> x -> [(Int, y)])
-> ([x] -> [y] -> T x ny)
-> (ny -> y)
-> T x y ny
Cons {
      ssvFromNodes :: [a] -> [a] -> String
ssvFromNodes =
         \[a]
xs [a]
ys -> [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> a -> String) -> [a] -> [a] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y) [a]
xs [a]
ys,
      interpolatePiece :: T a a (a, a)
interpolatePiece = T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1,
      basisOverlap :: Int
basisOverlap = Int
4,
      basisFunctions :: [a] -> [T a (a, a)]
basisFunctions = [a] -> [T a (a, a)]
forall a. Fractional a => [a] -> [T a (a, a)]
Basis.cubicLinear,
      sampleBasisFunctions :: [a] -> a -> [(Int, a)]
sampleBasisFunctions = [a] -> a -> [(Int, a)]
forall a. (Fractional a, Ord a) => T a a
Sample.cubicLinear,
      coefficientsToInterpolator :: [a] -> [a] -> T a (a, a)
coefficientsToInterpolator = [a] -> [a] -> T a (a, a)
forall a. Fractional a => [a] -> [a] -> T a (a, a)
Basis.coefficientsToCubicLinear,
      valueFromNode :: (a, a) -> a
valueFromNode = (a, a) -> a
forall a b. (a, b) -> a
fst
   }

{- |
prop> checkOverlap Type.cubicParabola
-}
cubicParabola :: (Fractional a, Ord a, Show a) => T a a (a, a)
cubicParabola :: T a a (a, a)
cubicParabola =
   Cons :: forall x y ny.
([x] -> [y] -> String)
-> T x y ny
-> Int
-> ([x] -> [T x ny])
-> ([x] -> x -> [(Int, y)])
-> ([x] -> [y] -> T x ny)
-> (ny -> y)
-> T x y ny
Cons {
      ssvFromNodes :: [a] -> [a] -> String
ssvFromNodes =
         \[a]
xs [a]
ys -> [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> a -> String) -> [a] -> [a] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y) [a]
xs [a]
ys,
      interpolatePiece :: T a a (a, a)
interpolatePiece = T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1,
      basisOverlap :: Int
basisOverlap = Int
4,
      basisFunctions :: [a] -> [T a (a, a)]
basisFunctions = [a] -> [T a (a, a)]
forall a. Fractional a => [a] -> [T a (a, a)]
Basis.cubicParabola,
      sampleBasisFunctions :: [a] -> a -> [(Int, a)]
sampleBasisFunctions = [a] -> a -> [(Int, a)]
forall a. (Fractional a, Ord a) => T a a
Sample.cubicParabola,
      coefficientsToInterpolator :: [a] -> [a] -> T a (a, a)
coefficientsToInterpolator = [a] -> [a] -> T a (a, a)
forall a. Fractional a => [a] -> [a] -> T a (a, a)
Basis.coefficientsToCubicParabola,
      valueFromNode :: (a, a) -> a
valueFromNode = (a, a) -> a
forall a b. (a, b) -> a
fst
   }


_cubicMean :: (Fractional a, Ord a, Show a) => T a a (a, a)
_cubicMean :: T a a (a, a)
_cubicMean =
   Cons :: forall x y ny.
([x] -> [y] -> String)
-> T x y ny
-> Int
-> ([x] -> [T x ny])
-> ([x] -> x -> [(Int, y)])
-> ([x] -> [y] -> T x ny)
-> (ny -> y)
-> T x y ny
Cons {
      ssvFromNodes :: [a] -> [a] -> String
ssvFromNodes =
         \[a]
xs [a]
ys -> [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> a -> String) -> [a] -> [a] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y) [a]
xs [a]
ys,
      interpolatePiece :: T a a (a, a)
interpolatePiece = T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1,
      basisOverlap :: Int
basisOverlap = Int
4,
      basisFunctions :: [a] -> [T a (a, a)]
basisFunctions = [a] -> [T a (a, a)]
forall a. Fractional a => [a] -> [T a (a, a)]
Basis.cubicParabola, -- Basis.cubicMean,
      sampleBasisFunctions :: [a] -> a -> [(Int, a)]
sampleBasisFunctions = [a] -> a -> [(Int, a)]
forall a. (Fractional a, Ord a) => T a a
Sample.cubicParabola, -- Sample.cubicMean,
      coefficientsToInterpolator :: [a] -> [a] -> T a (a, a)
coefficientsToInterpolator = [a] -> [a] -> T a (a, a)
forall a. Fractional a => [a] -> [a] -> T a (a, a)
Basis.coefficientsToCubicParabola, -- not correct
      valueFromNode :: (a, a) -> a
valueFromNode = (a, a) -> a
forall a b. (a, b) -> a
fst
   }