{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Interpolation (
   T, func, offset, number,
   zeroPad, constantPad, cyclicPad, extrapolationPad,
   single,
   multiRelative,
   multiRelativeZeroPad, multiRelativeConstantPad,
   multiRelativeCyclicPad, multiRelativeExtrapolationPad,
   multiRelativeZeroPadConstant, multiRelativeZeroPadLinear,
   multiRelativeZeroPadCubic,

   constant, linear, cubic,
   piecewise, function,

   Interpolation.Margin, Interpolation.margin,

   -- for testing
   singleRec,
   ) where

import qualified Synthesizer.Interpolation as Interpolation
import Synthesizer.Interpolation (T, offset, number, )
import Synthesizer.Interpolation.Module
          (constant, linear, cubic, piecewise, function, )

import qualified Synthesizer.State.Signal       as SigS

import qualified Synthesizer.Plain.Signal  as Sig
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR

import Control.Monad (guard, )

import qualified Data.List.HT as ListHT
import Data.Maybe (fromMaybe)

import qualified Algebra.Module    as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing  as RealRing
import qualified Algebra.Ring      as Ring
import qualified Algebra.Additive  as Additive

import NumericPrelude.Numeric
import NumericPrelude.Base


{-* Interpolation with various padding methods -}

zeroPad :: (RealRing.C t) =>
   (T t y -> t -> Sig.T y -> a) ->
   y -> T t y -> t -> Sig.T y -> a
zeroPad :: forall t y a.
C t =>
(T t y -> t -> T y -> a) -> y -> T t y -> t -> T y -> a
zeroPad T t y -> t -> T y -> a
interpolate y
z T t y
ip t
phase T y
x =
   let (Int
phInt, t
phFrac) = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
   in  T t y -> t -> T y -> a
interpolate T t y
ip t
phFrac
          (y -> Int -> T y -> T y
forall y. y -> Int -> T y -> T y
FiltNR.delayPad y
z (T t y -> Int
forall t y. T t y -> Int
offset T t y
ip Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
phInt) (T y
x T y -> T y -> T y
forall a. [a] -> [a] -> [a]
++ y -> T y
forall a. a -> [a]
repeat y
z))

constantPad :: (RealRing.C t) =>
   (T t y -> t -> Sig.T y -> a) ->
   T t y -> t -> Sig.T y -> a
constantPad :: forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
constantPad T t y -> t -> T y -> a
interpolate T t y
ip t
phase T y
x =
   let (Int
phInt, t
phFrac) = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
       xPad :: Maybe (T y)
xPad =
          do (y
xFirst,T y
_) <- T y -> Maybe (y, T y)
forall a. [a] -> Maybe (a, [a])
ListHT.viewL T y
x
             (T y
xBody,y
xLast) <- T y -> Maybe (T y, y)
forall a. [a] -> Maybe ([a], a)
ListHT.viewR T y
x
             T y -> Maybe (T y)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (y -> Int -> T y -> T y
forall y. y -> Int -> T y -> T y
FiltNR.delayPad y
xFirst (T t y -> Int
forall t y. T t y -> Int
offset T t y
ip Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
phInt) (T y
xBody T y -> T y -> T y
forall a. [a] -> [a] -> [a]
++ y -> T y
forall a. a -> [a]
repeat y
xLast))
   in  T t y -> t -> T y -> a
interpolate T t y
ip t
phFrac
          (T y -> Maybe (T y) -> T y
forall a. a -> Maybe a -> a
fromMaybe [] Maybe (T y)
xPad)


{- |
Only for finite input signals.
-}
cyclicPad :: (RealRing.C t) =>
   (T t y -> t -> Sig.T y -> a) ->
   T t y -> t -> Sig.T y -> a
cyclicPad :: forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
cyclicPad T t y -> t -> T y -> a
interpolate T t y
ip t
phase T y
x =
   let (Int
phInt, t
phFrac) = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
   in  T t y -> t -> T y -> a
interpolate T t y
ip t
phFrac
          (Int -> T y -> T y
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. C a => a -> a -> a
mod (Int
phInt Int -> Int -> Int
forall a. C a => a -> a -> a
- T t y -> Int
forall t y. T t y -> Int
offset T t y
ip) (T y -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length T y
x)) (T y -> T y
forall a. HasCallStack => [a] -> [a]
cycle T y
x))

{- |
The extrapolation may miss some of the first and some of the last points
-}
extrapolationPad :: (RealRing.C t) =>
   (T t y -> t -> Sig.T y -> a) ->
   T t y -> t -> Sig.T y -> a
extrapolationPad :: forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
extrapolationPad T t y -> t -> T y -> a
interpolate T t y
ip t
phase =
   T t y -> t -> T y -> a
interpolate T t y
ip (t
phase t -> t -> t
forall a. C a => a -> a -> a
- Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral (T t y -> Int
forall t y. T t y -> Int
offset T t y
ip))
{-
  This example shows pikes, although there shouldn't be any:
   plotList (take 100 $ interpolate (Zero (0::Double)) ipCubic (-0.9::Double) (repeat 0.03) [1,0,1,0.8])
-}


{-* Interpolation of multiple values with various padding methods -}

func ::
   T t y -> t -> Sig.T y -> y
func :: forall t y. T t y -> t -> T y -> y
func T t y
ip t
phase =
   T t y -> t -> T y -> y
forall t y. T t y -> t -> T y -> y
Interpolation.func T t y
ip t
phase (T y -> y) -> (T y -> T y) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> T y
forall y. [y] -> T y
SigS.fromList

skip :: (RealRing.C t) =>
   T t y -> (t, Sig.T y) -> (t, Sig.T y)
skip :: forall t y. C t => T t y -> (t, T y) -> (t, T y)
skip T t y
ip (t
phase0, T y
x0) =
   let (Int
n, t
frac) = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase0
       (Int
m, T y
x1) = Int -> Int -> T y -> (Int, T y)
forall a. Int -> Int -> T a -> (Int, T a)
Sig.dropMarginRem (T t y -> Int
forall t y. T t y -> Int
number T t y
ip) Int
n T y
x0
   in  (Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral Int
m t -> t -> t
forall a. C a => a -> a -> a
+ t
frac, T y
x1)

single :: (RealRing.C t) =>
   T t y -> t -> Sig.T y -> y
single :: forall t y. C t => T t y -> t -> T y -> y
single T t y
ip t
phase0 T y
x0 =
   (t -> T y -> y) -> (t, T y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> t -> T y -> y
forall t y. T t y -> t -> T y -> y
func T t y
ip) ((t, T y) -> y) -> (t, T y) -> y
forall a b. (a -> b) -> a -> b
$ T t y -> (t, T y) -> (t, T y)
forall t y. C t => T t y -> (t, T y) -> (t, T y)
skip T t y
ip (t
phase0, T y
x0)
--   curry (uncurry (func ip) . skip ip)
{-
GNUPlot.plotFunc [] (GNUPlot.linearScale 1000 (0,2)) (\t -> single linear (t::Double) [0,4,1::Double])
-}

-- | alternative implementation of 'single'
singleRec :: (Ord t, Ring.C t) =>
   T t y -> t -> Sig.T y -> y
singleRec :: forall t y. (Ord t, C t) => T t y -> t -> T y -> y
singleRec T t y
ip t
phase T y
x =
   -- check if we are leaving the current interval
   y -> (T y -> y) -> Maybe (T y) -> y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (T t y -> t -> T y -> y
forall t y. T t y -> t -> T y -> y
func T t y
ip t
phase T y
x)
      (T t y -> t -> T y -> y
forall t y. (Ord t, C t) => T t y -> t -> T y -> y
singleRec T t y
ip (t
phase t -> t -> t
forall a. C a => a -> a -> a
- t
1))
      (do (y
_,T y
xs) <- T y -> Maybe (y, T y)
forall a. [a] -> Maybe (a, [a])
ListHT.viewL T y
x
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t
phase t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
1 Bool -> Bool -> Bool
&& Int -> T y -> Bool
forall a. Int -> T a -> Bool
Sig.lengthAtLeast (T t y -> Int
forall t y. T t y -> Int
number T t y
ip) T y
xs)
          T y -> Maybe (T y)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return T y
xs)


{-* Interpolation of multiple values with various padding methods -}

{- | All values of frequency control must be non-negative. -}
multiRelative :: (RealRing.C t) =>
   T t y -> t -> Sig.T y -> Sig.T t -> Sig.T y
multiRelative :: forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase0 T y
x0 =
   ((t, T y) -> y) -> [(t, T y)] -> T y
forall a b. (a -> b) -> [a] -> [b]
map ((t -> T y -> y) -> (t, T y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> t -> T y -> y
forall t y. T t y -> t -> T y -> y
func T t y
ip)) ([(t, T y)] -> T y) -> (T t -> [(t, T y)]) -> T t -> T y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((t, T y) -> t -> (t, T y)) -> (t, T y) -> T t -> [(t, T y)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
      (\(t
phase,T y
x) t
freq -> T t y -> (t, T y) -> (t, T y)
forall t y. C t => T t y -> (t, T y) -> (t, T y)
skip T t y
ip (t
phase t -> t -> t
forall a. C a => a -> a -> a
+ t
freq, T y
x))
      (T t y -> (t, T y) -> (t, T y)
forall t y. C t => T t y -> (t, T y) -> (t, T y)
skip T t y
ip (t
phase0,T y
x0))


multiRelativeZeroPad :: (RealRing.C t) =>
   y -> T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPad :: forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
z T t y
ip t
phase T t
fs T y
x =
   (T t y -> t -> T y -> T t -> T y)
-> y -> T t y -> t -> T y -> T t -> T y
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> y -> T t y -> t -> T y -> a
zeroPad T t y -> t -> T y -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative y
z T t y
ip t
phase T y
x T t
fs

multiRelativeConstantPad :: (RealRing.C t) =>
   T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeConstantPad :: forall t y. C t => T t y -> t -> T t -> T y -> T y
multiRelativeConstantPad T t y
ip t
phase T t
fs T y
x =
   (T t y -> t -> T y -> T t -> T y)
-> T t y -> t -> T y -> T t -> T y
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
constantPad T t y -> t -> T y -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase T y
x T t
fs

multiRelativeCyclicPad :: (RealRing.C t) =>
   T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeCyclicPad :: forall t y. C t => T t y -> t -> T t -> T y -> T y
multiRelativeCyclicPad T t y
ip t
phase T t
fs T y
x =
   (T t y -> t -> T y -> T t -> T y)
-> T t y -> t -> T y -> T t -> T y
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
cyclicPad T t y -> t -> T y -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase T y
x T t
fs

{- |
The extrapolation may miss some of the first and some of the last points
-}
multiRelativeExtrapolationPad :: (RealRing.C t) =>
   T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeExtrapolationPad :: forall t y. C t => T t y -> t -> T t -> T y -> T y
multiRelativeExtrapolationPad T t y
ip t
phase T t
fs T y
x =
   (T t y -> t -> T y -> T t -> T y)
-> T t y -> t -> T y -> T t -> T y
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
extrapolationPad T t y -> t -> T y -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase T y
x T t
fs
{-
  This example shows pikes, although there shouldn't be any:
   plotList (take 100 $ interpolate (Zero (0::Double)) ipCubic (-0.9::Double) (repeat 0.03) [1,0,1,0.8])
-}

{-* All-in-one interpolation functions -}

multiRelativeZeroPadConstant ::
   (RealRing.C t, Additive.C y) => t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPadConstant :: forall t y. (C t, C y) => t -> T t -> T y -> T y
multiRelativeZeroPadConstant = y -> T t y -> t -> T t -> T y -> T y
forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
forall a. C a => a
zero T t y
forall t y. T t y
constant

multiRelativeZeroPadLinear ::
   (RealRing.C t, Module.C t y) => t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPadLinear :: forall t y. (C t, C t y) => t -> T t -> T y -> T y
multiRelativeZeroPadLinear = y -> T t y -> t -> T t -> T y -> T y
forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
forall a. C a => a
zero T t y
forall t y. C t y => T t y
linear

multiRelativeZeroPadCubic ::
   (RealField.C t, Module.C t y) => t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPadCubic :: forall t y. (C t, C t y) => t -> T t -> T y -> T y
multiRelativeZeroPadCubic = y -> T t y -> t -> T t -> T y -> T y
forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
forall a. C a => a
zero T t y
forall t y. (C t, C t y) => T t y
cubic