{-# LANGUAGE NoImplicitPrelude #-}
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
{-# 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)
{-# 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
{-# 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)
{-# 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]
:
[]
{-# INLINE function #-}
function :: (Interpol.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
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)
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
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