module Numeric.Interpolation.Type (
   T(..),
   linear,
   cubic,
   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 Numeric.Interpolation.Private.Basis (hermite1Split)


data T x y ny =
   Cons {
      ssvFromNodes :: [x] -> [y] -> String,
      interpolatePiece :: Piece.T x y ny,
      basisFunctions :: [x] -> [Nodes.T x ny],
      coefficientsToInterpolator :: [x] -> [y] -> Nodes.T x ny,
      valueFromNode :: ny -> y
   }

linear :: T Double Double Double
linear =
   Cons {
      ssvFromNodes =
         \xs ys -> unlines $ zipWith (\x y -> show x ++ " " ++ show y) xs ys,
      interpolatePiece = Piece.linear,
      basisFunctions = Basis.linear,
      coefficientsToInterpolator = Basis.coefficientsToLinear,
      valueFromNode = id
   }

cubic :: T Double Double (Double, Double)
cubic =
   Cons {
      ssvFromNodes =
         \xs ys ->
            unlines .
            zipWith (\x (y,dy) -> show x ++ " " ++ show y ++ " " ++ show dy) xs $
            hermite1Split xs ys,
      interpolatePiece = Piece.hermite1,
      basisFunctions = Basis.hermite1,
      coefficientsToInterpolator = Basis.coefficientsToHermite1,
      valueFromNode = fst
   }

cubicLinear :: T Double Double (Double, Double)
cubicLinear =
   Cons {
      ssvFromNodes =
         \xs ys -> unlines $ zipWith (\x y -> show x ++ " " ++ show y) xs ys,
      interpolatePiece = Piece.hermite1,
      basisFunctions = Basis.cubicLinear,
      coefficientsToInterpolator = Basis.coefficientsToCubicLinear,
      valueFromNode = fst
   }

cubicParabola :: T Double Double (Double, Double)
cubicParabola =
   Cons {
      ssvFromNodes =
         \xs ys -> unlines $ zipWith (\x y -> show x ++ " " ++ show y) xs ys,
      interpolatePiece = Piece.hermite1,
      basisFunctions = Basis.cubicParabola,
      coefficientsToInterpolator = Basis.coefficientsToCubicParabola,
      valueFromNode = fst
   }


_cubicMean :: T Double Double (Double, Double)
_cubicMean =
   Cons {
      ssvFromNodes =
         \xs ys -> unlines $ zipWith (\x y -> show x ++ " " ++ show y) xs ys,
      interpolatePiece = Piece.hermite1,
      basisFunctions = Basis.cubicParabola, -- Basis.cubicMean,
      coefficientsToInterpolator = Basis.coefficientsToCubicParabola, -- not correct
      valueFromNode = fst
   }