Interpolation.hs

module Test.Sound.Synthesizer.Plain.Interpolation (
   T, ip,
   LinePreserving, lpIp,
   tests,
   use, useLP, use2,
   ) where

import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Synthesizer.Interpolation.Custom as ExampleCustom
import qualified Synthesizer.Interpolation.Module as ExampleModule
import qualified Synthesizer.Interpolation as InterpolationCore

import Test.QuickCheck (test, Arbitrary(..), elements, {- Property, (==>), -} Testable, )
-- import Test.Utility

import qualified Algebra.VectorSpace           as VectorSpace
import qualified Algebra.Module                as Module
-- import qualified Algebra.RealField             as RealField
import qualified Algebra.Field                 as Field
-- import qualified Algebra.Ring                  as Ring
-- import qualified Algebra.Additive              as Additive

import Control.Monad (liftM2, )

import Test.Utility (equalList, )


import NumericPrelude
import PreludeBase
import Prelude ()



instance Arbitrary InterpolationCore.Margin where
   arbitrary =
      liftM2 InterpolationCore.Margin
         (fmap abs arbitrary)
         (fmap abs arbitrary)
   coarbitrary = undefined


use ::
   (Interpolation.T a v -> x) ->
   (T a v -> x)
use f ipt =
   f (ip ipt)

useLP ::
   (Interpolation.T a v -> x) ->
   (LinePreserving a v -> x)
useLP f ipt =
   f (lpIp ipt)

use2 ::
   (Interpolation.T a v ->
    Interpolation.T a v -> x) ->
   (T a v ->
    T a v -> x)
use2 f =
   use $ \ ipLeap ->
   use $ \ ipStep ->
      f ipLeap ipStep



data T a v = Cons {name :: String, ip :: Interpolation.T a v}

instance Show (T a v) where
   show x = name x

instance (Field.C a, Interpol.C a v) => Arbitrary (T a v) where
   arbitrary = elements $
      Cons "constant" ExampleCustom.constant :
      Cons "linear"   ExampleCustom.linear :
      Cons "cubic"    ExampleCustom.cubic :
      []
   coarbitrary = undefined



data LinePreserving a v =
   LPCons {lpName :: String, lpIp :: Interpolation.T a v}

instance Show (LinePreserving a v) where
   show x = lpName x

instance (Field.C a, Interpol.C a v) => Arbitrary (LinePreserving a v) where
   arbitrary = elements $
      LPCons "linear"   ExampleCustom.linear :
      LPCons "cubic"    ExampleCustom.cubic :
      []
   coarbitrary = undefined



constant ::
   (Interpol.C a v, Module.C a v, Eq v) =>
   a -> v -> [v] -> Bool
constant t x0 xs =
   equalList $ map ($(x0:xs)) $ map ($t) $
      Interpolation.func ExampleCustom.constant :
      Interpolation.func ExampleCustom.piecewiseConstant :
      Interpolation.func ExampleModule.constant :
      Interpolation.func ExampleModule.piecewiseConstant :
      []

linear ::
   (Interpol.C a v, Module.C a v, Eq v) =>
   a -> v -> v -> [v] -> Bool
linear t x0 x1 xs =
   equalList $ map ($(x0:x1:xs)) $ map ($t) $
      Interpolation.func ExampleCustom.linear :
      Interpolation.func ExampleCustom.piecewiseLinear :
      Interpolation.func ExampleModule.linear :
      Interpolation.func ExampleModule.piecewiseLinear :
      []

cubic ::
   (Interpol.C a v, VectorSpace.C a v, Eq v) =>
   a -> v -> v -> v -> v -> [v] -> Bool
cubic t x0 x1 x2 x3 xs =
   equalList $ map ($(x0:x1:x2:x3:xs)) $ map ($t) $
      Interpolation.func ExampleCustom.cubic :
      Interpolation.func ExampleCustom.piecewiseCubic :
      Interpolation.func ExampleModule.cubic :
      Interpolation.func ExampleModule.cubicAlt :
      Interpolation.func ExampleModule.piecewiseCubic :
      []


testRational ::
   (Testable t) =>
   (Rational -> Rational -> t) -> IO ()
testRational = test

tests :: [(String, IO ())]
tests =
   ("constant", testRational constant) :
   ("linear",   testRational linear  ) :
   ("cubic",    testRational cubic   ) :
   []