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 Control.Monad (liftM, liftM2)

import qualified Data.List as List
import Data.Maybe (catMaybes)


mapAdjacentMaybe3 :: (Maybe a -> a -> Maybe a -> b) -> [a] -> [b]
mapAdjacentMaybe3 f xs =
   let jxs = map Just xs
   in  zipWith3 f (Nothing : jxs) xs (drop 1 jxs ++ [Nothing])

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


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

hermite1 :: (Num b) => [a] -> [Nodes.T a (b, b)]
hermite1 xs =
   generic (0,0) (1,0) xs
   ++
   generic (0,0) (0,1) xs




mapAdjacentMaybe5 ::
   (Maybe a -> Maybe a -> a -> Maybe a -> Maybe a -> b) ->
   [a] -> [b]
mapAdjacentMaybe5 f xs =
   let jxs = map Just xs
       lxs1 = Nothing : jxs
       lxs2 = Nothing : lxs1
       rxs1 = drop 1 $ jxs ++ repeat Nothing
       rxs2 = drop 1 $ rxs1
   in  List.zipWith5 f lxs2 lxs1 xs rxs1 rxs2

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


{- |
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 =
   cubicAutoGeneric
      (\ll _l n -> recip $ n-ll)
      (\_l _n _r -> 0)
      (\n _r rr -> recip $ n-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 =
   cubicAutoGeneric
      parabolaBasisDerivativeRight
      parabolaBasisDerivativeCenter
      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 =
   cubicAutoGeneric
      (\ll l n -> (parabolaBasisDerivativeRight ll l n + recip (n-ll))/2)
      (\l n r -> parabolaBasisDerivativeCenter l n r / 2)
      (\n r rr -> (parabolaBasisDerivativeLeft n r rr + recip (n-rr))/2)