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

import qualified Numeric.Interpolation.NodeList as Nodes
import qualified Numeric.Interpolation.Piece as Piece
import Numeric.Interpolation.Private.List (mapAdjacentMaybe3, )
import Numeric.Interpolation.Private.Basis (
   parabolaBasisDerivativeRight,
   parabolaBasisDerivativeCenter,
   parabolaBasisDerivativeLeft,
   )


type T x y = [x] -> x -> [(Int, y)]

linear :: (Fractional a, Ord a) => T a a
linear :: T a a
linear [a]
nodeXs =
   let nodes :: T a Int
nodes = [(a, Int)] -> T a Int
forall x y. [(x, y)] -> T x y
Nodes.fromList ([(a, Int)] -> T a Int) -> [(a, Int)] -> T a Int
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
nodeXs [Int
0..]
   in  \a
x ->
          case T a Int -> a -> (Maybe (a, Int), Maybe (a, Int))
forall x y. Ord x => T x y -> x -> (Maybe (x, y), Maybe (x, y))
Nodes.lookup T a Int
nodes a
x of
             (Just (a
l,Int
nl), Just (a
r,Int
nr)) ->
                [(Int
nl, T a a a
forall a. Fractional a => T a a a
Piece.linear (a
l,a
1) (a
r,a
0) a
x),
                 (Int
nr, T a a a
forall a. Fractional a => T a a a
Piece.linear (a
l,a
0) (a
r,a
1) a
x)]
             (Just (a
_l,Int
nl), Maybe (a, Int)
Nothing) -> [(Int
nl, a
1)]
             (Maybe (a, Int)
Nothing, Just (a
_r,Int
nr)) -> [(Int
nr, a
1)]
             (Maybe (a, Int)
Nothing, Maybe (a, Int)
Nothing) -> []

hermite1 :: (Fractional a, Ord a) => T a a
hermite1 :: T a a
hermite1 [a]
nodeXs =
   let nodes :: T a Int
nodes = [(a, Int)] -> T a Int
forall x y. [(x, y)] -> T x y
Nodes.fromList ([(a, Int)] -> T a Int) -> [(a, Int)] -> T a Int
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
nodeXs [Int
0..]
   in  \a
x ->
          case T a Int -> a -> (Maybe (a, Int), Maybe (a, Int))
forall x y. Ord x => T x y -> x -> (Maybe (x, y), Maybe (x, y))
Nodes.lookup T a Int
nodes a
x of
             (Just (a
l,Int
nl), Just (a
r,Int
nr)) ->
                [(Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
0, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
1,a
0)) (a
r,(a
0,a
0)) a
x),
                 (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
0,a
1)) (a
r,(a
0,a
0)) a
x),
                 (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
0, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
0,a
0)) (a
r,(a
1,a
0)) a
x),
                 (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
0,a
0)) (a
r,(a
0,a
1)) a
x)]
             (Just (a
_l,Int
nl), Maybe (a, Int)
Nothing) -> [(Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nl, a
1)]
             (Maybe (a, Int)
Nothing, Just (a
_r,Int
nr)) -> [(Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nr, a
1)]
             (Maybe (a, Int)
Nothing, Maybe (a, Int)
Nothing) -> []

cubicLinear :: (Fractional a, Ord a) => T a a
cubicLinear :: T a a
cubicLinear [a]
nodeXs =
   let nodes :: T a (Int, (Maybe a, Maybe a))
nodes =
          [(a, (Int, (Maybe a, Maybe a)))] -> T a (Int, (Maybe a, Maybe a))
forall x y. [(x, y)] -> T x y
Nodes.fromList ([(a, (Int, (Maybe a, Maybe a)))] -> T a (Int, (Maybe a, Maybe a)))
-> [(a, (Int, (Maybe a, Maybe a)))]
-> T a (Int, (Maybe a, Maybe a))
forall a b. (a -> b) -> a -> b
$ [a]
-> [(Int, (Maybe a, Maybe a))] -> [(a, (Int, (Maybe a, Maybe a)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
nodeXs ([(Int, (Maybe a, Maybe a))] -> [(a, (Int, (Maybe a, Maybe a)))])
-> [(Int, (Maybe a, Maybe a))] -> [(a, (Int, (Maybe a, Maybe a)))]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Maybe a, Maybe a)] -> [(Int, (Maybe a, Maybe a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Maybe a, Maybe a)] -> [(Int, (Maybe a, Maybe a))])
-> [(Maybe a, Maybe a)] -> [(Int, (Maybe a, Maybe a))]
forall a b. (a -> b) -> a -> b
$
          (Maybe a -> a -> Maybe a -> (Maybe a, Maybe a))
-> [a] -> [(Maybe a, Maybe a)]
forall a b. (Maybe a -> a -> Maybe a -> b) -> [a] -> [b]
mapAdjacentMaybe3 (\Maybe a
l a
_ Maybe a
r -> (Maybe a
l,Maybe a
r)) [a]
nodeXs
   in  \a
x ->
          case T a (Int, (Maybe a, Maybe a))
-> a
-> (Maybe (a, (Int, (Maybe a, Maybe a))),
    Maybe (a, (Int, (Maybe a, Maybe a))))
forall x y. Ord x => T x y -> x -> (Maybe (x, y), Maybe (x, y))
Nodes.lookup T a (Int, (Maybe a, Maybe a))
nodes a
x of
             (Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing, Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing) -> []
             (Just (a
_l,(Int
nl,(Maybe a, Maybe a)
_)), Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing) -> [(Int
nlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, a
1)]
             (Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing, Just (a
_r,(Int
nr,(Maybe a, Maybe a)
_))) -> [(Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, a
1)]
             (Just (a
l,(Int
nl,(Maybe a
mll,Maybe a
_))), Just (a
r,(Int
nr,(Maybe a
_,Maybe a
mrr)))) ->
                let interL :: a -> (Int, a)
interL a
ll =
                       (Int
nlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
0,a -> a
forall a. Fractional a => a -> a
recip(a
lla -> a -> a
forall a. Num a => a -> a -> a
-a
r))) (a
r,(a
0,a
0)) a
x)
                    interR :: a -> (Int, a)
interR a
rr =
                       (Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
0,a
0)) (a
r,(a
0,a -> a
forall a. Fractional a => a -> a
recip(a
rra -> a -> a
forall a. Num a => a -> a -> a
-a
l))) a
x)
                in  case (Maybe a
mll,Maybe a
mrr) of
                       (Just a
ll, Just a
rr) ->
                          a -> (Int, a)
interL a
ll (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          (Int
nl, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
1,a
0)) (a
r,(a
0,a -> a
forall a. Fractional a => a -> a
recip(a
la -> a -> a
forall a. Num a => a -> a -> a
-a
rr))) a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          (Int
nr, T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1 (a
l,(a
0,a -> a
forall a. Fractional a => a -> a
recip(a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
ll))) (a
r,(a
1,a
0)) a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          a -> (Int, a)
interR a
rr (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          []
                       (Just a
ll, Maybe a
Nothing) -> a -> (Int, a)
interL a
ll (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int
nl, a
1)]
                       (Maybe a
Nothing, Just a
rr) -> a -> (Int, a)
interR a
rr (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int
nr, a
1)]
                       (Maybe a
Nothing, Maybe a
Nothing) -> []

cubicParabola :: (Fractional a, Ord a) => T a a
cubicParabola :: T a a
cubicParabola [a]
nodeXs =
   let nodes :: T a (Int, (Maybe a, Maybe a))
nodes =
          [(a, (Int, (Maybe a, Maybe a)))] -> T a (Int, (Maybe a, Maybe a))
forall x y. [(x, y)] -> T x y
Nodes.fromList ([(a, (Int, (Maybe a, Maybe a)))] -> T a (Int, (Maybe a, Maybe a)))
-> [(a, (Int, (Maybe a, Maybe a)))]
-> T a (Int, (Maybe a, Maybe a))
forall a b. (a -> b) -> a -> b
$ [a]
-> [(Int, (Maybe a, Maybe a))] -> [(a, (Int, (Maybe a, Maybe a)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
nodeXs ([(Int, (Maybe a, Maybe a))] -> [(a, (Int, (Maybe a, Maybe a)))])
-> [(Int, (Maybe a, Maybe a))] -> [(a, (Int, (Maybe a, Maybe a)))]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Maybe a, Maybe a)] -> [(Int, (Maybe a, Maybe a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Maybe a, Maybe a)] -> [(Int, (Maybe a, Maybe a))])
-> [(Maybe a, Maybe a)] -> [(Int, (Maybe a, Maybe a))]
forall a b. (a -> b) -> a -> b
$
          (Maybe a -> a -> Maybe a -> (Maybe a, Maybe a))
-> [a] -> [(Maybe a, Maybe a)]
forall a b. (Maybe a -> a -> Maybe a -> b) -> [a] -> [b]
mapAdjacentMaybe3 (\Maybe a
l a
_ Maybe a
r -> (Maybe a
l,Maybe a
r)) [a]
nodeXs
   in  \a
x ->
          case T a (Int, (Maybe a, Maybe a))
-> a
-> (Maybe (a, (Int, (Maybe a, Maybe a))),
    Maybe (a, (Int, (Maybe a, Maybe a))))
forall x y. Ord x => T x y -> x -> (Maybe (x, y), Maybe (x, y))
Nodes.lookup T a (Int, (Maybe a, Maybe a))
nodes a
x of
             (Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing, Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing) -> []
             (Just (a
_l,(Int
nl,(Maybe a, Maybe a)
_)), Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing) -> [(Int
nlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, a
1)]
             (Maybe (a, (Int, (Maybe a, Maybe a)))
Nothing, Just (a
_r,(Int
nr,(Maybe a, Maybe a)
_))) -> [(Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, a
1)]
             (Just (a
l,(Int
nl,(Maybe a
mll,Maybe a
_))), Just (a
r,(Int
nr,(Maybe a
_,Maybe a
mrr)))) ->
                let interL :: a -> (Int, a)
interL a
ll =
                       (Int
nlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,
                        T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1
                           (a
l,(a
0, a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeLeft a
ll a
l a
r))
                           (a
r,(a
0, a
0))
                           a
x)
                    interR :: a -> (Int, a)
interR a
rr =
                       (Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,
                        T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1
                           (a
l,(a
0, a
0))
                           (a
r,(a
0, a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeRight a
l a
r a
rr))
                           a
x)
                in  case (Maybe a
mll,Maybe a
mrr) of
                       (Just a
ll, Just a
rr) ->
                          a -> (Int, a)
interL a
ll (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          (Int
nl,
                           T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1
                              (a
l, (a
1, a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeCenter a
ll a
l a
r))
                              (a
r, (a
0, a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeLeft a
l a
r a
rr))
                              a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          (Int
nr,
                           T a a (a, a)
forall a. Fractional a => T a a (a, a)
Piece.hermite1
                              (a
l, (a
0, a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeRight a
ll a
l a
r))
                              (a
r, (a
1, a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeCenter a
l a
r a
rr))
                              a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          a -> (Int, a)
interR a
rr (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
                          []
                       (Just a
ll, Maybe a
Nothing) -> a -> (Int, a)
interL a
ll (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int
nl, a
1)]
                       (Maybe a
Nothing, Just a
rr) -> a -> (Int, a)
interR a
rr (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int
nr, a
1)]
                       (Maybe a
Nothing, Maybe a
Nothing) -> []