{-# LANGUAGE NoImplicitPrelude #-}
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
{-# 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)
{-# 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)
{-# 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]
:
[]
{-# INLINE function #-}
function :: (Module.C t y) =>
(Int,Int)
-> (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)
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)