{-# LANGUAGE NoImplicitPrelude #-}
{- |
Special interpolations defined in terms of Module operations.
-}
module Synthesizer.Interpolation.Module (
   T,
   constant,
   linear,
   cubic,
   cubicAlt,
   piecewise,
   piecewiseConstant,
   piecewiseLinear,
   piecewiseCubic,
   function,
   ) where

import qualified Synthesizer.State.Signal  as Sig
import qualified Synthesizer.Plain.Control as Ctrl

import qualified Synthesizer.Interpolation.Core as Core

import Synthesizer.Interpolation (
   T, cons, getNode, fromPrefixReader,
   constant,
   )

import qualified Algebra.Module    as Module
import qualified Algebra.Field     as Field

import qualified Control.Applicative.HT as App

import NumericPrelude.Numeric
import NumericPrelude.Base


{-| Consider the signal to be piecewise linear. -}
{-# INLINE linear #-}
linear :: (Module.C t y) => T t y
linear :: forall t y. C t y => T t y
linear =
   String -> Int -> PrefixReader y (t -> y) -> T t y
forall y t. String -> Int -> PrefixReader y (t -> y) -> T t y
fromPrefixReader String
"linear" Int
0
      ((y -> y -> t -> y)
-> PrefixReader y y -> PrefixReader y y -> PrefixReader y (t -> y)
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 y -> y -> t -> y
forall a v. C a v => v -> v -> a -> v
Core.linear PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode)

{- |
Consider the signal to be piecewise cubic,
with smooth connections at the nodes.
It uses a cubic curve which has node values
x0 at 0 and x1 at 1 and derivatives
(x1-xm1)/2 and (x2-x0)/2, respectively.
You can see how it works
if you evaluate the expression for t=0 and t=1
as well as the derivative at these points.
-}
{-# INLINE cubic #-}
cubic :: (Field.C t, Module.C t y) => T t y
cubic :: forall t y. (C t, C t y) => T t y
cubic =
   String -> Int -> PrefixReader y (t -> y) -> T t y
forall y t. String -> Int -> PrefixReader y (t -> y) -> T t y
fromPrefixReader String
"cubic" Int
1
      ((y -> y -> y -> y -> t -> y)
-> PrefixReader y y
-> PrefixReader y y
-> PrefixReader y y
-> PrefixReader y y
-> PrefixReader y (t -> y)
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 y -> y -> y -> y -> t -> y
forall a v. (C a v, C a) => v -> v -> v -> v -> a -> v
Core.cubic PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode)

{-# INLINE cubicAlt #-}
cubicAlt :: (Field.C t, Module.C t y) => T t y
cubicAlt :: forall t y. (C t, C t y) => T t y
cubicAlt =
   String -> Int -> PrefixReader y (t -> y) -> T t y
forall y t. String -> Int -> PrefixReader y (t -> y) -> T t y
fromPrefixReader String
"cubicAlt" Int
1
      ((y -> y -> y -> y -> t -> y)
-> PrefixReader y y
-> PrefixReader y y
-> PrefixReader y y
-> PrefixReader y y
-> PrefixReader y (t -> y)
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 y -> y -> y -> y -> t -> y
forall a v. (C a v, C a) => v -> v -> v -> v -> a -> v
Core.cubicAlt PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode PrefixReader y y
forall y. PrefixReader y y
getNode)



{-** Interpolation based on piecewise defined functions -}

{-# INLINE piecewise #-}
piecewise :: (Module.C t y) =>
   Int -> [t -> t] -> T t y
piecewise :: forall t y. C t y => Int -> [t -> t] -> T t y
piecewise Int
center [t -> t]
ps =
   Int -> Int -> (t -> T y -> y) -> T t y
forall t y. Int -> Int -> (t -> T y -> y) -> T t y
cons ([t -> t] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> t]
ps) (Int
centerInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)
      (\t
t -> T t -> T y -> y
forall t y. C t y => T t -> T y -> y
Sig.linearComb ([t] -> T t
forall y. [y] -> T y
Sig.fromList (((t -> t) -> t) -> [t -> t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ t
t) ([t -> t] -> [t -> t]
forall a. [a] -> [a]
reverse [t -> t]
ps))))

{-# INLINE piecewiseConstant #-}
piecewiseConstant :: (Module.C t y) => T t y
piecewiseConstant :: forall t y. C t y => T t y
piecewiseConstant =
   Int -> [t -> t] -> T t y
forall t y. C t y => Int -> [t -> t] -> T t y
piecewise Int
1 [t -> t -> t
forall a b. a -> b -> a
const t
1]

{-# INLINE piecewiseLinear #-}
piecewiseLinear :: (Module.C t y) => T t y
piecewiseLinear :: forall t y. C t y => T t y
piecewiseLinear =
   Int -> [t -> t] -> T t y
forall t y. C t y => Int -> [t -> t] -> T t y
piecewise Int
1 [t -> t
forall a. a -> a
id, (t
1t -> t -> t
forall a. C a => a -> a -> a
-)]

{-# INLINE piecewiseCubic #-}
piecewiseCubic :: (Field.C t, Module.C t y) => T t y
piecewiseCubic :: forall t y. (C t, C t y) => T t y
piecewiseCubic =
   Int -> [t -> t] -> T t y
forall t y. C t y => Int -> [t -> t] -> T t y
piecewise Int
2 ([t -> t] -> T t y) -> [t -> t] -> T t y
forall a b. (a -> b) -> a -> b
$
      (t, (t, t)) -> (t, (t, t)) -> t -> t
forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (t
0,(t
0,t
0))    (t
1,(t
0,t
1t -> t -> t
forall a. C a => a -> a -> a
/t
2)) (t -> t) -> [t -> t] -> [t -> t]
forall a. a -> [a] -> [a]
:
      (t, (t, t)) -> (t, (t, t)) -> t -> t
forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (t
0,(t
0,t
1t -> t -> t
forall a. C a => a -> a -> a
/t
2))  (t
1,(t
1,t
0)) (t -> t) -> [t -> t] -> [t -> t]
forall a. a -> [a] -> [a]
:
      (t, (t, t)) -> (t, (t, t)) -> t -> t
forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (t
0,(t
1,t
0))    (t
1,(t
0,-t
1t -> t -> t
forall a. C a => a -> a -> a
/t
2)) (t -> t) -> [t -> t] -> [t -> t]
forall a. a -> [a] -> [a]
:
      (t, (t, t)) -> (t, (t, t)) -> t -> t
forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (t
0,(t
0,-t
1t -> t -> t
forall a. C a => a -> a -> a
/t
2)) (t
1,(t
0,t
0)) (t -> t) -> [t -> t] -> [t -> t]
forall a. a -> [a] -> [a]
:
      []

{-
GNUPlot.plotList [] $ take 100 $ interpolate (Zero 0) piecewiseCubic (-2.3 :: Double) (repeat 0.1) [2,1,2::Double]
-}


{-** Interpolation based on arbitrary functions -}

{- | with this wrapper you can use the collection of interpolating functions from Donadio's DSP library -}
{-# INLINE function #-}
function :: (Module.C t y) =>
      (Int,Int)   {- ^ @(left extent, right extent)@, e.g. @(1,1)@ for linear hat -}
   -> (t -> t)
   -> T t y
function :: forall t y. C t y => (Int, Int) -> (t -> t) -> T t y
function (Int
left,Int
right) t -> t
f =
   let len :: Int
len = Int
leftInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
right
       ps :: T Int
ps  = Int -> T Int -> T Int
forall a. Int -> T a -> T a
Sig.take Int
len (T Int -> T Int) -> T Int -> T Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> T Int
forall a. (a -> a) -> a -> T a
Sig.iterate Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int
forall a. Enum a => a -> a
pred Int
right)
       -- ps = Sig.reverse $ Sig.take len $ Sig.iterate succ (-left)
   in  Int -> Int -> (t -> T y -> y) -> T t y
forall t y. Int -> Int -> (t -> T y -> y) -> T t y
cons Int
len Int
left
          (\t
t -> T t -> T y -> y
forall t y. C t y => T t -> T y -> y
Sig.linearComb (T t -> T y -> y) -> T t -> T y -> y
forall a b. (a -> b) -> a -> b
$
                   (Int -> t) -> T Int -> T t
forall a b. (a -> b) -> T a -> T b
Sig.map (\Int
x -> t -> t
f (t
t t -> t -> t
forall a. C a => a -> a -> a
+ Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral Int
x)) T Int
ps)
{-
GNUPlot.plotList [] $ take 300 $ interpolate (Zero 0) (function (1,1) (\x -> exp (-6*x*x))) (-2.3 :: Double) (repeat 0.03) [2,1,2::Double]
-}