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

import qualified Synthesizer.State.Signal  as Sig
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.Interpolation.Class as Interpol

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

import qualified Algebra.Field     as Field

import Synthesizer.Interpolation.Class ((+.*), )

import qualified Control.Applicative.HT as App

import NumericPrelude.Numeric
import NumericPrelude.Base



{-| Consider the signal to be piecewise linear. -}
{-# INLINE linear #-}
linear :: (Interpol.C t y) => T t y
linear :: forall t y. C t y => T t y
linear =
   forall y t. String -> Int -> PrefixReader y (t -> y) -> T t y
fromPrefixReader String
"linear" Int
0
      (forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2
          (\y
x0 y
x1 t
phase -> forall a v. C a v => a -> (v, v) -> v
Interpol.combine2 t
phase (y
x0,y
x1))
          forall y. PrefixReader y y
getNode 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, Interpol.C t y) => T t y
cubic :: forall t y. (C t, C t y) => T t y
cubic =
   forall y t. String -> Int -> PrefixReader y (t -> y) -> T t y
fromPrefixReader String
"cubicAlt" Int
1 forall a b. (a -> b) -> a -> b
$ 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
xm1 y
x0 y
x1 y
x2 t
t ->
       let (t
am1, t
a0, t
a1) = forall t. C t => t -> (t, t, t)
cubicHalf    t
t
           ( t
b2, t
b1, t
b0) = forall t. C t => t -> (t, t, t)
cubicHalf (t
1forall a. C a => a -> a -> a
-t
t)
       in  forall a v. C a v => (a, v) -> v
Interpol.scale (t
am1,y
xm1)
             forall a v. C a v => v -> (a, v) -> v
+.* (t
a0forall a. C a => a -> a -> a
+t
b0,y
x0)
             forall a v. C a v => v -> (a, v) -> v
+.* (t
a1forall a. C a => a -> a -> a
+t
b1,y
x1)
             forall a v. C a v => v -> (a, v) -> v
+.* (t
b2,y
x2))
      forall y. PrefixReader y y
getNode forall y. PrefixReader y y
getNode forall y. PrefixReader y y
getNode forall y. PrefixReader y y
getNode

{- |
See 'cubicHalfModule'.
-}
{-# INLINE cubicHalf #-}
cubicHalf :: (Field.C t) => t -> (t,t,t)
cubicHalf :: forall t. C t => t -> (t, t, t)
cubicHalf t
t =
   let c :: t
c = (t
tforall a. C a => a -> a -> a
-t
1)forall a. C a => a -> Integer -> a
^Integer
2
       ct2 :: t
ct2 = t
cforall a. C a => a -> a -> a
*t
tforall a. C a => a -> a -> a
/t
2
   in  (-t
ct2, t
cforall a. C a => a -> a -> a
*(t
1forall a. C a => a -> a -> a
+t
2forall a. C a => a -> a -> a
*t
t), t
ct2)


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

{- |
List of functions must be non-empty.
-}
{-# INLINE piecewise #-}
piecewise :: (Interpol.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 =
   forall t y. Int -> Int -> (t -> T y -> y) -> T t y
cons (forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> t]
ps) (Int
centerforall a. C a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$
   \t
t ->
      forall a v. C a v => String -> String -> T a -> T v -> v
combineMany
         String
"Interpolation.element: list of functions empty"
         String
"Interpolation.element: list of samples empty" forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> T a -> T b
Sig.map (forall a b. (a -> b) -> a -> b
$ t
t) forall a b. (a -> b) -> a -> b
$ forall y. [y] -> T y
Sig.fromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [t -> t]
ps

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

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

{-# INLINE piecewiseCubic #-}
piecewiseCubic :: (Field.C t, Interpol.C t y) => T t y
piecewiseCubic :: forall t y. (C t, C t y) => T t y
piecewiseCubic =
   forall t y. C t y => Int -> [t -> t] -> T t y
piecewise Int
2 forall a b. (a -> b) -> a -> b
$
      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
1forall a. C a => a -> a -> a
/t
2)) forall a. a -> [a] -> [a]
:
      forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (t
0,(t
0,t
1forall a. C a => a -> a -> a
/t
2))  (t
1,(t
1,t
0)) forall a. a -> [a] -> [a]
:
      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
1forall a. C a => a -> a -> a
/t
2)) forall a. a -> [a] -> [a]
:
      forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (t
0,(t
0,-t
1forall a. C a => a -> a -> a
/t
2)) (t
1,(t
0,t
0)) 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 :: (Interpol.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
leftforall a. C a => a -> a -> a
+Int
right
       ps :: T Int
ps  = forall a. Int -> T a -> T a
Sig.take Int
len forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> T a
Sig.iterate forall a. Enum a => a -> a
pred (forall a. Enum a => a -> a
pred Int
right)
       -- ps = Sig.reverse $ Sig.take len $ Sig.iterate succ (-left)
   in  forall t y. Int -> Int -> (t -> T y -> y) -> T t y
cons Int
len Int
left forall a b. (a -> b) -> a -> b
$
       \t
t ->
          forall a v. C a v => String -> String -> T a -> T v -> v
combineMany
             String
"Interpolation.function: empty function domain"
             String
"Interpolation.function: list of samples empty" forall a b. (a -> b) -> a -> b
$
             forall a b. (a -> b) -> T a -> T b
Sig.map (\Int
x -> t -> t
f (t
t forall a. C a => a -> a -> a
+ 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]
-}

combineMany ::
   (Interpol.C a v) =>
   String -> String ->
   Sig.T a -> Sig.T v -> v
combineMany :: forall a v. C a v => String -> String -> T a -> T v -> v
combineMany String
msgCoefficients String
msgSamples T a
ct T v
xt =
   forall b a. b -> (a -> T a -> b) -> T a -> b
Sig.switchL (forall a. HasCallStack => String -> a
error String
msgCoefficients)
      (\a
c T a
cs ->
         forall b a. b -> (a -> T a -> b) -> T a -> b
Sig.switchL (forall a. HasCallStack => String -> a
error String
msgSamples)
            (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a v. C a v => (a, T a) -> (v, T v) -> v
Interpol.combineMany (a
c,T a
cs)))
            T v
xt)
      T a
ct