{- |
Interpolation basis functions represented with a minimum of required nodes.
-}
module Numeric.Interpolation.Basis.Compact (
   linear, hermite1, cubicLinear, cubicParabola,
   ) where

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

import Control.Monad (liftM, liftM2)

import Data.Maybe (catMaybes)


generic :: ny -> ny -> [x] -> [Nodes.T x ny]
generic :: ny -> ny -> [x] -> [T x ny]
generic ny
nz ny
ny =
   (Maybe x -> x -> Maybe x -> T x ny) -> [x] -> [T x ny]
forall a b. (Maybe a -> a -> Maybe a -> b) -> [a] -> [b]
mapAdjacentMaybe3
      (\Maybe x
l x
n Maybe x
r ->
          (x, ny) -> T x ny -> T x ny -> T x ny
forall x y. (x, y) -> T x y -> T x y -> T x y
Nodes.Node (x
n,ny
ny)
             (T x ny -> (x -> T x ny) -> Maybe x -> T x ny
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T x ny
forall x y. T x y
Nodes.Interval ((x -> ny -> T x ny) -> ny -> x -> T x ny
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> ny -> T x ny
forall x y. x -> y -> T x y
Nodes.singleton ny
nz) Maybe x
l)
             (T x ny -> (x -> T x ny) -> Maybe x -> T x ny
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T x ny
forall x y. T x y
Nodes.Interval ((x -> ny -> T x ny) -> ny -> x -> T x ny
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> ny -> T x ny
forall x y. x -> y -> T x y
Nodes.singleton ny
nz) Maybe x
r))


linear :: (Num b) => [a] -> [Nodes.T a b]
linear :: [a] -> [T a b]
linear = b -> b -> [a] -> [T a b]
forall ny x. ny -> ny -> [x] -> [T x ny]
generic b
0 b
1

hermite1 :: (Num b) => [a] -> [Nodes.T a (b, b)]
hermite1 :: [a] -> [T a (b, b)]
hermite1 [a]
xs =
   [[T a (b, b)]] -> [T a (b, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[T a (b, b)]] -> [T a (b, b)]) -> [[T a (b, b)]] -> [T a (b, b)]
forall a b. (a -> b) -> a -> b
$
   (T a (b, b) -> T a (b, b) -> [T a (b, b)])
-> [T a (b, b)] -> [T a (b, b)] -> [[T a (b, b)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\T a (b, b)
f T a (b, b)
df -> [T a (b, b)
f,T a (b, b)
df])
      ((b, b) -> (b, b) -> [a] -> [T a (b, b)]
forall ny x. ny -> ny -> [x] -> [T x ny]
generic (b
0,b
0) (b
1,b
0) [a]
xs)
      ((b, b) -> (b, b) -> [a] -> [T a (b, b)]
forall ny x. ny -> ny -> [x] -> [T x ny]
generic (b
0,b
0) (b
0,b
1) [a]
xs)




cubicAutoGeneric ::
   (Num b) =>
   (a -> a -> a -> b) ->
   (a -> a -> a -> b) ->
   (a -> a -> a -> b) ->
   [a] -> [Nodes.T a (b, b)]
cubicAutoGeneric :: (a -> a -> a -> b)
-> (a -> a -> a -> b) -> (a -> a -> a -> b) -> [a] -> [T a (b, b)]
cubicAutoGeneric a -> a -> a -> b
dl a -> a -> a -> b
dn a -> a -> a -> b
dr =
   (Maybe a -> Maybe a -> a -> Maybe a -> Maybe a -> T a (b, b))
-> [a] -> [T a (b, b)]
forall a b.
(Maybe a -> Maybe a -> a -> Maybe a -> Maybe a -> b) -> [a] -> [b]
mapAdjacentMaybe5
      (\Maybe a
ml2 Maybe a
ml1 a
n Maybe a
mr1 Maybe a
mr2 ->
         let node :: a -> a -> b -> (a, (a, b))
node a
x a
y b
y' = (a
x, (a
y,b
y'))
         in  [(a, (b, b))] -> T a (b, b)
forall x y. [(x, y)] -> T x y
Nodes.fromList ([(a, (b, b))] -> T a (b, b)) -> [(a, (b, b))] -> T a (b, b)
forall a b. (a -> b) -> a -> b
$ [Maybe (a, (b, b))] -> [(a, (b, b))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (a, (b, b))] -> [(a, (b, b))])
-> [Maybe (a, (b, b))] -> [(a, (b, b))]
forall a b. (a -> b) -> a -> b
$
             (a -> (a, (b, b))) -> Maybe a -> Maybe (a, (b, b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
l2 -> a -> b -> b -> (a, (b, b))
forall a a b. a -> a -> b -> (a, (a, b))
node a
l2 b
0 b
0) Maybe a
ml2 Maybe (a, (b, b)) -> [Maybe (a, (b, b))] -> [Maybe (a, (b, b))]
forall a. a -> [a] -> [a]
:
             (a -> a -> (a, (b, b))) -> Maybe a -> Maybe a -> Maybe (a, (b, b))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\a
l2 a
l1 -> a -> b -> b -> (a, (b, b))
forall a a b. a -> a -> b -> (a, (a, b))
node a
l1 b
0 (a -> a -> a -> b
dl a
l2 a
l1 a
n)) Maybe a
ml2 Maybe a
ml1 Maybe (a, (b, b)) -> [Maybe (a, (b, b))] -> [Maybe (a, (b, b))]
forall a. a -> [a] -> [a]
:
             (a -> a -> (a, (b, b))) -> Maybe a -> Maybe a -> Maybe (a, (b, b))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\a
l1 a
r1 -> a -> b -> b -> (a, (b, b))
forall a a b. a -> a -> b -> (a, (a, b))
node a
n  b
1 (a -> a -> a -> b
dn a
l1 a
n a
r1)) Maybe a
ml1 Maybe a
mr1 Maybe (a, (b, b)) -> [Maybe (a, (b, b))] -> [Maybe (a, (b, b))]
forall a. a -> [a] -> [a]
:
             (a -> a -> (a, (b, b))) -> Maybe a -> Maybe a -> Maybe (a, (b, b))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\a
r1 a
r2 -> a -> b -> b -> (a, (b, b))
forall a a b. a -> a -> b -> (a, (a, b))
node a
r1 b
0 (a -> a -> a -> b
dr a
n a
r1 a
r2)) Maybe a
mr1 Maybe a
mr2 Maybe (a, (b, b)) -> [Maybe (a, (b, b))] -> [Maybe (a, (b, b))]
forall a. a -> [a] -> [a]
:
             (a -> (a, (b, b))) -> Maybe a -> Maybe (a, (b, b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
r2 -> a -> b -> b -> (a, (b, b))
forall a a b. a -> a -> b -> (a, (a, b))
node a
r2 b
0 b
0) Maybe a
mr2 Maybe (a, (b, b)) -> [Maybe (a, (b, b))] -> [Maybe (a, (b, b))]
forall a. a -> [a] -> [a]
:
             [])


{- |
Cubic interpolation
where the derivative at a node is set to the slope of the two adjacent nodes.
-}
cubicLinear :: (Fractional a) => [a] -> [Nodes.T a (a, a)]
cubicLinear :: [a] -> [T a (a, a)]
cubicLinear =
   (a -> a -> a -> a)
-> (a -> a -> a -> a) -> (a -> a -> a -> a) -> [a] -> [T a (a, a)]
forall b a.
Num b =>
(a -> a -> a -> b)
-> (a -> a -> a -> b) -> (a -> a -> a -> b) -> [a] -> [T a (b, b)]
cubicAutoGeneric
      (\a
ll a
_l a
n -> a -> a
forall a. Fractional a => a -> a
recip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
na -> a -> a
forall a. Num a => a -> a -> a
-a
ll)
      (\a
_l a
_n a
_r -> a
0)
      (\a
n a
_r a
rr -> a -> a
forall a. Fractional a => a -> a
recip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
na -> a -> a
forall a. Num a => a -> a -> a
-a
rr)


{- |
Cubic interpolation
where the derivative at a node is set to the slope of the parabola
through the current and the two adjacent nodes.
-}
cubicParabola :: (Fractional a) => [a] -> [Nodes.T a (a, a)]
cubicParabola :: [a] -> [T a (a, a)]
cubicParabola =
   (a -> a -> a -> a)
-> (a -> a -> a -> a) -> (a -> a -> a -> a) -> [a] -> [T a (a, a)]
forall b a.
Num b =>
(a -> a -> a -> b)
-> (a -> a -> a -> b) -> (a -> a -> a -> b) -> [a] -> [T a (b, b)]
cubicAutoGeneric
      a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeRight
      a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeCenter
      a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeLeft


{- |
Experimental interpolation
which is mean of 'cubicLinear' and 'cubicParabola'.
The result looks reasonable, too.
-}
_cubicMean :: (Fractional a) => [a] -> [Nodes.T a (a, a)]
_cubicMean :: [a] -> [T a (a, a)]
_cubicMean =
   (a -> a -> a -> a)
-> (a -> a -> a -> a) -> (a -> a -> a -> a) -> [a] -> [T a (a, a)]
forall b a.
Num b =>
(a -> a -> a -> b)
-> (a -> a -> a -> b) -> (a -> a -> a -> b) -> [a] -> [T a (b, b)]
cubicAutoGeneric
      (\a
ll a
l a
n -> (a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeRight a
ll a
l a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Fractional a => a -> a
recip (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
ll))a -> a -> a
forall a. Fractional a => a -> a -> a
/a
2)
      (\a
l a
n a
r -> a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeCenter a
l a
n a
r a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
      (\a
n a
r a
rr -> (a -> a -> a -> a
forall a. Fractional a => a -> a -> a -> a
parabolaBasisDerivativeLeft a
n a
r a
rr a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Fractional a => a -> a
recip (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
rr))a -> a -> a
forall a. Fractional a => a -> a -> a
/a
2)