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) -> []